Group_99/D7zzXiangHeng
5
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Apply new .gitignore

Browse Source
This commit is contained in:
DESKTOP-E401PHE\Administrator 2025-08-08 11:41:33 +08:00
parent 8ac4fefe4d
commit 8169687b1f
77 changed files with 252319 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.gitignore vendored
View File

@ -4,6 +4,7 @@
**/image
**/doc
**/wav
**/DownLoad
**/__history
**/__recovery
*.dll
@ -13,4 +14,11 @@
*.~pas
*.~dfm
*.~ddp
*.~dpr
*.~dpr
*.~dpr
*.~bpg
*.identcache
*.local
*.zip
*.rar
*.pdf

307
Z99Dependency/RTFunAndForm/Form/U_LabelAdd.dfm Normal file
View File

@ -0,0 +1,307 @@
object frmLabelAdd: TfrmLabelAdd
Left = 191
Top = 109
Width = 997
Height = 612
BorderIcons = [biMaximize]
Caption = #26631#31614#32534#36753
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Panel1: TPanel
Left = 0
Top = 28
Width = 413
Height = 513
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 0
object Label1: TLabel
Left = 40
Top = 404
Width = 60
Height = 12
Caption = #23458#25143#21517#31216#65306
Enabled = False
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
Visible = False
end
object Label2: TLabel
Left = 31
Top = 69
Width = 60
Height = 12
Caption = #26631#31614#25991#20214#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label3: TLabel
Left = 31
Top = 95
Width = 60
Height = 12
Caption = #22791' '#27880#65306
end
object Label9: TLabel
Left = 32
Top = 16
Width = 60
Height = 12
Caption = #26631#31614#21517#31216#65306
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object Label10: TLabel
Left = 32
Top = 44
Width = 60
Height = 12
Caption = #26631#31614#31867#22411#65306
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
end
object customerNo: TBtnEditA
Left = 104
Top = 400
Width = 295
Height = 20
Enabled = False
ReadOnly = True
TabOrder = 0
Visible = False
OnBtnClick = customerNoBtnClick
end
object LabelFileName: TBtnEditA
Left = 92
Top = 65
Width = 260
Height = 20
ReadOnly = True
TabOrder = 1
OnBtnClick = LabelFileNameBtnClick
end
object beizhu: TMemo
Left = 92
Top = 92
Width = 257
Height = 149
ScrollBars = ssBoth
TabOrder = 2
end
object BtOpen: TBitBtn
Left = 353
Top = 64
Width = 36
Height = 19
Caption = #25171#24320
TabOrder = 3
OnClick = BtOpenClick
end
object LabelCaption: TEdit
Left = 92
Top = 12
Width = 260
Height = 20
TabOrder = 4
end
object LabelType: TFTComboBox
Tag = 99
Left = 92
Top = 37
Width = 260
Height = 20
Style = csDropDownList
ItemHeight = 12
ItemIndex = 0
TabOrder = 5
Text = #20013#25991#26631#31614
Items.Strings = (
#20013#25991#26631#31614
#33521#25991#26631#31614
#20013#33521#25991#26631#31614)
end
end
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 981
Height = 20
AutoSize = True
ButtonHeight = 18
ButtonWidth = 60
Caption = 'ToolBar2'
Color = clBtnFace
Flat = True
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 1
Transparent = False
object Tsave: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384#26631#31614
ImageIndex = 5
OnClick = TsaveClick
end
object Tclose: TToolButton
Left = 64
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 10
OnClick = TcloseClick
end
end
object RMPreview1: TRMPreview
Left = 428
Top = 20
Width = 553
Height = 553
Align = alRight
BevelOuter = bvLowered
Caption = #26631#31614#39044#35272
TabOrder = 2
OnDblClick = RMPreview1DblClick
Options.RulerUnit = rmutScreenPixels
Options.RulerVisible = False
Options.DrawBorder = False
Options.BorderPen.Color = clGray
Options.BorderPen.Style = psDash
end
object ADOQueryCmd: TADOQuery
Connection = LabelSet_DataLink.ADOLink
CommandTimeout = 300
Parameters = <>
Left = 512
Top = 208
end
object OpenDialog1: TOpenDialog
Filter = 'RMFl(*.rmf)|*.rmf'
InitialDir = '.'
Left = 200
Top = 4
end
object RMGridReport1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
ShowPrintDialog = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
Preview = RMPreview1
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 336
Top = 8
ReportData = {}
end
object ADOQueryTmp: TADOQuery
Connection = LabelSet_DataLink.ADOLink
LockType = ltReadOnly
CommandTimeout = 300
Parameters = <>
Left = 528
Top = 184
end
object RMGridReportDesigner1: TRMGridReportDesigner
Left = 376
Top = 8
end
object RMBarCodeObject1: TRMBarCodeObject
Left = 280
Top = 4
end
object RMBMPExport1: TRMBMPExport
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
Left = 408
Top = 8
end
object RMXLSExport1: TRMXLSExport
ShowAfterExport = True
ExportPrecision = 1
PagesOfSheet = 10
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 440
Top = 8
end
object RMDS_Main: TRMDBDataSet
Visible = True
AliasName = #26631#31614#25968#25454
Left = 498
Top = 72
end
object RMDataDictionary1: TRMDataDictionary
FieldFieldNames.TableName = 'TableName'
FieldFieldNames.FieldName = 'FieldName'
FieldFieldNames.FieldAlias = 'FieldAlias'
Left = 562
Top = 72
end
object ADOQuery1: TADOQuery
Connection = LabelSet_DataLink.ADOLink
Parameters = <>
Left = 352
Top = 480
end
object RMGridReport2: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDS_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 432
Top = 368
ReportData = {}
end
end

344
Z99Dependency/RTFunAndForm/Form/U_LabelAdd.pas Normal file
View File

@ -0,0 +1,344 @@
unit U_LabelAdd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, ExtCtrls, DB, ADODB,
RM_System, RM_Common, RM_Class, RM_GridReport, Buttons, FTComboBox,
RM_Preview, RM_e_Xls, RM_e_Graphic, RM_e_bmp, RM_BarCode,
RM_DsgGridReport, RM_Dataset, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid;
type
TfrmLabelAdd = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
customerNo: TBtnEditA;
LabelFileName: TBtnEditA;
beizhu: TMemo;
ToolBar1: TToolBar;
Tsave: TToolButton;
Tclose: TToolButton;
ADOQueryCmd: TADOQuery;
OpenDialog1: TOpenDialog;
RMGridReport1: TRMGridReport;
BtOpen: TBitBtn;
Label9: TLabel;
LabelCaption: TEdit;
Label10: TLabel;
LabelType: TFTComboBox;
ADOQueryTmp: TADOQuery;
RMPreview1: TRMPreview;
RMGridReportDesigner1: TRMGridReportDesigner;
RMBarCodeObject1: TRMBarCodeObject;
RMBMPExport1: TRMBMPExport;
RMXLSExport1: TRMXLSExport;
RMDS_Main: TRMDBDataSet;
RMDataDictionary1: TRMDataDictionary;
ADOQuery1: TADOQuery;
RMGridReport2: TRMGridReport;
procedure TcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TsaveClick(Sender: TObject);
procedure LabelFileNameBtnClick(Sender: TObject);
procedure customerNoBtnClick(Sender: TObject);
procedure BtOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure RMPreview1DblClick(Sender: TObject);
private
fIsChg:Boolean;
function SaveData():Boolean;
function EditData():Boolean;
procedure InitWinData();
procedure InitVarDictionary();
procedure InitDataSetDictionary();
public
fcustomNo:string;
fKeyNo:string;
fWinStatus:integer;
end;
var
frmLabelAdd: TfrmLabelAdd;
implementation
uses
U_DataLink,U_RTFun;
{$R *.dfm}
procedure TfrmLabelAdd.TcloseClick(Sender: TObject);
begin
if fIsChg then
begin
if application.MessageBox('标签设计过，是否要保存?','提示信息',1)=1 then
begin
Tsave.Click ;
end
else
close;
end
else
close;
end;
procedure TfrmLabelAdd.FormCreate(Sender: TObject);
begin
panel1.Align :=alClient;
fIsChg:=false;
// ClearWinData(panel1);
// InitVarDictionary();
end;
procedure TfrmLabelAdd.TsaveClick(Sender: TObject);
begin
if trim(labelCaption.Text)='' then
begin
application.MessageBox('标签名称不能为空！','提示');
labelCaption.SetFocus;
exit;
end;
if trim(LabelFileName.Text)='' then
begin
application.MessageBox('标签文件不能为空，请选择标签！','提示');
LabelFileName.SetFocus;
exit;
end;
if fWinStatus=0 then
begin
if SaveData() then
begin
ModalResult:=1;
end;
end
else
begin
if EditData() then
begin
ModalResult:=1;
end;
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能：保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelAdd.SaveData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from P_Label');
sql.Add('where 1<>1');
Open;
Append;
fieldByName('CustomerNO').value:=trim(customerno.txtCode);
fieldByName('filler').value:=DName;
fieldByName('filltime').value:=DServerDate;
fieldByName('beizhu').value:= trim(beizhu.text);
fieldByName('LabelCaption').value:=trim(LabelCaption.text);
fieldByName('LabelType').value:=trim(LabelType.text);
fieldByName('LabelFileName').value:= trim(LabelFileName.text);
//TBlobField(FieldByName('LabelFile')).LoadFromStream(fStream);
RMGridReport1.SaveToBlobField(TBlobField(FieldByName('LabelFile')));
Post;
end;
result:=true;
except
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
/////////////////////////////////////////////////////////////////////
//函数功能：保存数据
/////////////////////////////////////////////////////////////////////
function TfrmLabelAdd.EditData():Boolean;
begin
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from P_Label');
sql.Add('where labelId='+fkeyNo);
Open;
Edit;
fieldByName('LabelCaption').value:=trim(LabelCaption.text);
fieldByName('LabelType').value:=trim(LabelType.text);
fieldByName('LabelFileName').value:= trim(LabelFileName.text);
RMGridReport1.SaveToBlobField(TBlobField(FieldByName('LabelFile')));
fieldByName('Editer').value:=DName;
fieldByName('EditTime').value:=DServerDate;
fieldByName('beizhu').value:= trim(beizhu.text);
Post;
end;
result:=true;
except
Result:=false;
application.MessageBox('保存标签模板出错!','警告信息',0);
end;
end;
procedure TfrmLabelAdd.LabelFileNameBtnClick(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
LabelFileName.Text:=OpenDialog1.FileName;
RMGridReport1.LoadFromFile(LabelFileName.Text);
RMGridReport1.Preview :=RMPreview1;
RMGridReport1.ShowReport ;
end;
end;
procedure TfrmLabelAdd.customerNoBtnClick(Sender: TObject);
begin
{
FormGetCust:=TFormGetCust.Create(self);
if FormGetCust.ShowModal=mrok then
begin
customNo.TxtCode:=trim(FormGetCust.ADOQuery1.Fieldbyname('customno').AsString);
customNo.Text:=trim(FormGetCust.ADOQuery1.Fieldbyname('shortname').AsString);
end;
FormGetCust.Free;
}
{ frmCustHelp:=TfrmCustHelp.create(self);
with frmCustHelp do
begin
if showModal=1 then
begin
customNo.TxtCode:=trim(ADOQueryHelp.Fieldbyname('customno').AsString);
customNo.Text:=trim(ADOQueryHelp.Fieldbyname('shortname').AsString);
end;
free;
end; }
end;
procedure TfrmLabelAdd.BtOpenClick(Sender: TObject);
begin
with RMGridReport2 do
begin
if trim(LabelFileName.Text)='' then
LoadFromFile(ExtractFilePath(Application.ExeName)+'report/标签模板.rmf');
InitDataSetDictionary();
RMDS_Main.DataSet :=ADOQuery1;
application.ProcessMessages;
DesignReport() ;
fIsChg:=true;
RMDS_Main.DataSet :=nil;
RMGridReport1.NewReport;
RMGridReport1.LoadFromFile(LabelFileName.Text);
RMGridReport1.ShowReport ;
end;
end;
////////////////////////////////////////////////////////////
//初始化窗口数据
////////////////////////////////////////////////////////////
procedure TfrmLabelAdd.InitWinData();
begin
try
with ADOQueryTmp do
begin
close;
sql.Clear ;
sql.Add('select A.*');
// sql.Add('customNoName=isnull((select customName from BC_customer where customNO=A.customNo),A.customNo)');
sql.Add('from P_Label A');
sql.Add('WHERE LabelId='+fkeyNo);
Open;
if isEmpty then
begin
close;
exit;
end;
SSetWinData(ADOQueryTmp,panel1);
RMGridReport1.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport2.FileName:=trim(fieldByName('labelFileName').AsString);
RMGridReport2.LoadFromBlobField(tblobfield(fieldbyname('labelFile')));
RMGridReport1.Preview :=RMPreview1;
//RMGridReport1.PrepareReport;
RMGridReport1.ShowReport ;
end;
except
end;
end;
procedure TfrmLabelAdd.FormShow(Sender: TObject);
begin
if fWinStatus>0 then
InitWinData();
end;
procedure TfrmLabelAdd.RMPreview1DblClick(Sender: TObject);
begin
//btOpen.Click ;
end;
////////////////////////////////////////////////////////////
//
////////////////////////////////////////////////////////////
procedure TfrmLabelAdd.InitVarDictionary();
var
i:integer;
begin
{ try
with RMGridReport2 do
begin
Dictionary.Variables.Clear ;
Dictionary.Variables.AddCategory('客户单位信息');
with ADOQueryTmp do
begin
close;
sql.clear;
sql.Add('exec P_Label_CustPrintData');
sql.Add(quotedStr(fCustomNo));
Open;
for i:=0 to FieldCount-1 do
begin
Dictionary.Variables.Add(trim(fields[i].FieldName)
,'');
Dictionary.Variables.AsString[trim(fields[i].FieldName)]:=trim(fields[i].AsString);
end;
end;
end;
finally
end; }
end;
/////////////////////////////////////////////////
//
/////////////////////////////////////////////////
procedure TfrmLabelAdd.InitDataSetDictionary();
begin
{ with ADOQuery1 do
begin
close;
sql.Clear ;
sql.Add('exec P_Label_PrintSet');
sql.Add(quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
//sql.Add(','+quotedStr(''));
OPen;
end;
with RMGridReport2 do
begin
Dictionary.FieldAliases.Clear;
Dictionary.FieldAliases['RMDS_Main']:= '标签数据';
Dictionary.FieldAliases['RMDS_Main."barcode"']:='标签条码';
end; }
end;
end.

428
Z99Dependency/RTFunAndForm/Form/U_LabelList.dfm Normal file
View File

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

612
Z99Dependency/RTFunAndForm/Form/U_LabelList.pas Normal file
View File

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

18072
Z99Dependency/RTFunAndForm/Form/U_RTZDYHelp.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

686
Z99Dependency/RTFunAndForm/Form/U_RTZDYHelp.pas Normal file
View File

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

214
Z99Dependency/RTFunAndForm/Fun/U_MyClassHelpers.pas Normal file
View File

@ -0,0 +1,214 @@
unit U_MyClassHelpers;
interface
Uses
SysUtils,Windows,Classes,Graphics, Controls,Forms,Dialogs, Math,typinfo;
// uMySysUtils;
Const //记录设计时的屏幕分辨率
OriWidth=1366;
OriHeight=768;
{var
OriWidth,OriHeight:Integer; }
Type
TfmForm=Class(TForm) //实现窗体屏幕分辨率的自动调整
Private
fScrResolutionRateW: Double;
fScrResolutionRateH: Double;
fIsFitDeviceDone: Boolean;
procedure FitDeviceResolution;
Protected
Property IsFitDeviceDone:Boolean Read fIsFitDeviceDone;
Property ScrResolutionRateH:Double Read fScrResolutionRateH;
Property ScrResolutionRateW:Double Read fScrResolutionRateW;
Public
Constructor Create(AOwner: TComponent); Override;
End;
TfdForm=Class(TfmForm) //增加对话框窗体的修改确认
Protected
fIsDlgChange:Boolean;
Public
Constructor Create(AOwner: TComponent); Override;
Property IsDlgChange:Boolean Read fIsDlgChange default false;
End;
implementation
//uses UMain;
constructor TfmForm.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
fScrResolutionRateH:=1;
fScrResolutionRateW:=1;
Try
if Not fIsFitDeviceDone then
Begin
FitDeviceResolution;
fIsFitDeviceDone:=True;
End;
Except
fIsFitDeviceDone:=False;
End;
end;
procedure TfmForm.FitDeviceResolution;
Var
LocList:TList;
LocFontRate:Double;
LocFontSize:Integer;
LocFont:TFont;
locK:Integer;
//计算尺度调整的基本参数
Procedure CalBasicScalePars;
Begin
try
Self.Scaled:=False;
fScrResolutionRateH:=screen.height/OriHeight;
fScrResolutionRateW:=screen.Width/OriWidth;
LocFontRate:=Min(fScrResolutionRateH,fScrResolutionRateW);
except
Raise;
end;
End;
function PropertyExists(const AObject: TObject;const APropName:String):Boolean;
//判断一个属性是否存在
var
PropInfo:PPropInfo;
begin
PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
Result:=Assigned(PropInfo);
end;
function GetObjectProperty(
const AObject : TObject;
const APropName : string
):TObject;
var
PropInfo:PPropInfo;
begin
Result := nil;
PropInfo:=GetPropInfo(AObject.ClassInfo,APropName);
if Assigned(PropInfo) and
(PropInfo^.PropType^.Kind = tkClass) then
Result := GetObjectProp(AObject,PropInfo);
end;
//保存原有坐标位置：利用递归法遍历各级容器里的控件，直到最后一级
Procedure ControlsPostoList(vCtl:TControl;vList:TList);
Var
locPRect:^TRect;
i:Integer;
locCtl:TControl;
locFontp:^Integer;
Begin
try
New(locPRect);
locPRect^:=vCtl.BoundsRect;
vList.Add(locPRect);
If PropertyExists(vCtl,'FONT') Then
Begin
LocFont:=TFont(GetObjectProperty(vCtl,'FONT'));
New(locFontp);
locFontP^:=LocFont.Size;
vList.Add(locFontP);
// ShowMessage(vCtl.Name+'Ori:='+InttoStr(LocFont.Size));
End;
If vCtl Is TWinControl Then
For i:=0 to TWinControl(vCtl).ControlCount-1 Do
begin
locCtl:=TWinControl(vCtl).Controls[i];
ControlsPosToList(locCtl,vList);
end;
except
Raise;
end;
End;
//计算新的坐标位置：利用递归法遍历各级容器里的控件，直到最后一层。
// 计算坐标时先计算顶级容器级的，然后逐级递进
Procedure AdjustControlsScale(vCtl:TControl;vList:TList;Var vK:Integer);
Var
locOriRect,LocNewRect:TRect;
i:Integer;
locCtl:TControl;
Begin
try
If vCtl.Align<>alClient Then
Begin
locOriRect:=TRect(vList.Items[vK]^);
With locNewRect Do
begin
Left:=Round(locOriRect.Left*fScrResolutionRateW);
Right:=Round(locOriRect.Right*fScrResolutionRateW);
Top:=Round(locOriRect.Top*fScrResolutionRateH);
Bottom:=Round(locOriRect.Bottom*fScrResolutionRateH);
vCtl.SetBounds(Left,Top,Right-Left,Bottom-Top);
end;
End;
If PropertyExists(vCtl,'FONT') Then
Begin
Inc(vK);
LocFont:=TFont(GetObjectProperty(vCtl,'FONT'));
locFontSize:=Integer(vList.Items[vK]^);
LocFont.Size := Round(LocFontRate*locFontSize);
// ShowMessage(vCtl.Name+'New:='+InttoStr(LocFont.Size));
End;
Inc(vK);
If vCtl Is TWinControl Then
For i:=0 to TwinControl(vCtl).ControlCount-1 Do
begin
locCtl:=TWinControl(vCtl).Controls[i];
AdjustControlsScale(locCtl,vList,vK);
end;
except
Raise;
end;
End;
//释放坐标位置指针和列表对象
Procedure FreeListItem(vList:TList);
Var
i:Integer;
Begin
For i:=0 to vList.Count-1 Do
Dispose(vList.Items[i]);
vList.Free;
End;
begin
LocList:=TList.Create;
Try
Try
if (Screen.width<>OriWidth)OR(Screen.Height<>OriHeight) then
begin
CalBasicScalePars;
// AdjustComponentFont(Self);
ControlsPostoList(Self,locList);
locK:=0;
AdjustControlsScale(Self,locList,locK);
End;
Except on E:Exception Do
Raise Exception.Create('进行屏幕分辨率自适应调整时出现错误'+E.Message);
End;
Finally
FreeListItem(locList);
End;
end;
{ TfdForm }
constructor TfdForm.Create(AOwner: TComponent);
begin
inherited;
fIsDlgChange:=False;
end;
end.

4221
Z99Dependency/RTFunAndForm/Fun/U_RTFun.pas Normal file
View File

File diff suppressed because it is too large Load Diff

13
Z99Dependency/ThreeFun/Form/GetAddRess.dpr Normal file
View File

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

402
Z99Dependency/ThreeFun/Form/U_ClList.dfm Normal file
View File

@ -0,0 +1,402 @@
object frmClList: TfrmClList
Left = 141
Top = 134
Width = 889
Height = 528
Caption = #25104#21697#27979#35797#25253#21578
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 873
Height = 20
AutoSize = True
ButtonHeight = 18
ButtonWidth = 66
Caption = 'ToolBar1'
Color = clSkyBlue
Flat = True
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object tbselect: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #26597#35810
ImageIndex = 2
OnClick = tbselectClick
end
object tbadd: TToolButton
Left = 40
Top = 0
AutoSize = True
Caption = #22686#21152
ImageIndex = 3
OnClick = tbaddClick
end
object tbupdate: TToolButton
Left = 80
Top = 0
AutoSize = True
Caption = #20462#25913
ImageIndex = 54
OnClick = tbupdateClick
end
object tbdelete: TToolButton
Left = 120
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 48
OnClick = tbdeleteClick
end
object tbLook: TToolButton
Left = 160
Top = 0
AutoSize = True
Caption = #26597#30475
ImageIndex = 77
OnClick = tbLookClick
end
object ToolButton1: TToolButton
Left = 200
Top = 0
Caption = #23548#20986'Excel'
ImageIndex = 75
OnClick = ToolButton1Click
end
object tbPrintlb: TToolButton
Left = 266
Top = 0
Caption = #25171#21360#21015#34920
ImageIndex = 12
Visible = False
OnClick = tbPrintlbClick
end
object tbclose: TToolButton
Left = 332
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 55
OnClick = tbcloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 20
Width = 873
Height = 49
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label1: TLabel
Left = 16
Top = 20
Width = 48
Height = 12
Caption = #29983#20135#26085#26399
end
object Label2: TLabel
Left = 160
Top = 20
Width = 6
Height = 12
Caption = '-'
end
object Label3: TLabel
Left = 456
Top = 64
Width = 24
Height = 12
Caption = #23458#25143
end
object Label4: TLabel
Left = 608
Top = 64
Width = 24
Height = 12
Caption = #20135#21697
end
object Label5: TLabel
Left = 284
Top = 68
Width = 36
Height = 12
Caption = #35745#21010#21333
end
object Label6: TLabel
Left = 308
Top = 20
Width = 48
Height = 12
Caption = #21592#24037#32534#21495
end
object Label7: TLabel
Left = 500
Top = 20
Width = 48
Height = 12
Caption = #21592#24037#21517#31216
end
object begdate: TDateTimePicker
Left = 68
Top = 16
Width = 90
Height = 20
Date = 40533.591564594910000000
Format = 'yyyy-MM-dd'
Time = 40533.591564594910000000
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 0
end
object enddate: TDateTimePicker
Left = 168
Top = 16
Width = 90
Height = 20
Date = 40533.591593796290000000
Format = 'yyyy-MM-dd'
Time = 40533.591593796290000000
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 1
end
object customName: TEdit
Left = 480
Top = 60
Width = 100
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 2
end
object ChnName: TEdit
Left = 636
Top = 60
Width = 100
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 3
end
object planNo: TEdit
Left = 320
Top = 64
Width = 100
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 4
end
object userID: TEdit
Left = 360
Top = 16
Width = 121
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 5
end
object userName: TEdit
Left = 552
Top = 16
Width = 121
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 6
end
end
object cxGrid1: TcxGrid
Left = 0
Top = 69
Width = 873
Height = 328
Align = alTop
TabOrder = 2
object TV1: TcxGridDBTableView
OnDblClick = TV1DblClick
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
Column = V1P_Num
end
item
Kind = skSum
Column = V1packs
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.Editing = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
OptionsView.Indicator = True
object V1operTime: TcxGridDBColumn
Caption = #27979#35797#26085#26399
DataBinding.FieldName = 'operTime'
HeaderAlignmentHorz = taCenter
Width = 75
end
object V1planNo: TcxGridDBColumn
Caption = #35745#21010#21333
DataBinding.FieldName = 'planNo'
HeaderAlignmentHorz = taCenter
Width = 75
end
object V1customname: TcxGridDBColumn
Caption = #23458#25143
DataBinding.FieldName = 'customname'
HeaderAlignmentHorz = taCenter
Width = 75
end
object V1P_Code: TcxGridDBColumn
Caption = #20135#21697#32534#21495
DataBinding.FieldName = 'P_Code'
HeaderAlignmentHorz = taCenter
Width = 80
end
object V1P_ChnName: TcxGridDBColumn
Caption = #20135#21697#21517#31216
DataBinding.FieldName = 'P_ChnName'
HeaderAlignmentHorz = taCenter
Width = 120
end
object V1P_Spec: TcxGridDBColumn
Caption = #20135#21697#35268#26684
DataBinding.FieldName = 'P_Spec'
HeaderAlignmentHorz = taCenter
Width = 80
end
object V1colorname: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'colorname'
HeaderAlignmentHorz = taCenter
Width = 60
end
object V1P_YHNO: TcxGridDBColumn
Caption = #33457#21495
DataBinding.FieldName = 'P_YHNO'
HeaderAlignmentHorz = taCenter
Width = 60
end
object V1P_Colstd: TcxGridDBColumn
Caption = #33394#20301
DataBinding.FieldName = 'P_Colstd'
HeaderAlignmentHorz = taCenter
Width = 60
end
object V1packs: TcxGridDBColumn
Caption = #20214#25968
DataBinding.FieldName = 'packs'
HeaderAlignmentHorz = taCenter
Width = 60
end
object V1P_Num: TcxGridDBColumn
Caption = #25968#37327
DataBinding.FieldName = 'P_Num'
HeaderAlignmentHorz = taCenter
Width = 60
end
object V1P_unit: TcxGridDBColumn
Caption = #25968#37327#21333#20301
DataBinding.FieldName = 'P_unit'
HeaderAlignmentHorz = taCenter
Width = 75
end
object V1operatorName: TcxGridDBColumn
Caption = #27979#35797#20154#21592
DataBinding.FieldName = 'operatorName'
HeaderAlignmentHorz = taCenter
Width = 75
end
object V1note: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'note'
HeaderAlignmentHorz = taCenter
Width = 120
end
end
object cxGrid1Level1: TcxGridLevel
GridView = TV1
end
end
object Panetime: TPanel
Left = 308
Top = 120
Width = 191
Height = 41
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = #27491#22312#26597#35810#25968#25454#65292#35831#31561#24453'...'
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 3
Visible = False
end
object ADOQueryTmp: TADOQuery
AutoCalcFields = False
LockType = ltPessimistic
CommandTimeout = 600
Parameters = <>
Left = 392
Top = 180
end
object DataSource1: TDataSource
DataSet = ADOQueryTmp
Left = 428
Top = 60
end
object ADOQueryCmd: TADOQuery
Parameters = <>
Left = 492
Top = 68
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 568
Top = 4
end
object dxComponentPrinter1: TdxComponentPrinter
CurrentLink = dxComponentPrinter1Link1
DateFormat = 4
TimeFormat = 2
Version = 0
Left = 464
Top = 236
object dxComponentPrinter1Link1: TdxGridReportLink
Component = cxGrid1
PrinterPage.DMPaper = 1
PrinterPage.Footer = 6350
PrinterPage.Header = 6350
PrinterPage.Margins.Bottom = 12700
PrinterPage.Margins.Left = 12700
PrinterPage.Margins.Right = 12700
PrinterPage.Margins.Top = 12700
PrinterPage.PageSize.X = 215900
PrinterPage.PageSize.Y = 279400
PrinterPage._dxMeasurementUnits_ = 0
PrinterPage._dxLastMU_ = 2
BuiltInReportLink = True
end
end
end

337
Z99Dependency/ThreeFun/Form/U_ClList.pas Normal file
View File

@ -0,0 +1,337 @@
unit U_ClList;
interface
uses
Windows, Messages, SysUtils, StrUtils,Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, ExtCtrls, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB,
cxGridLevel, cxClasses, cxControls, cxGridCustomView,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, dxPSGlbl, dxPSUtl, dxPSEngn,
dxPrnPg, dxBkgnd, dxWrap, dxPrnDev, dxPSCompsProvider, dxPSFillPatterns,
dxPSEdgePatterns, dxPSCore, dxPScxCommon, dxPScxGridLnk;
type
TfrmClList = class(TForm)
ToolBar1: TToolBar;
tbselect: TToolButton;
tbadd: TToolButton;
tbupdate: TToolButton;
tbdelete: TToolButton;
tbclose: TToolButton;
Panel1: TPanel;
Label1: TLabel;
begdate: TDateTimePicker;
enddate: TDateTimePicker;
Label2: TLabel;
Label3: TLabel;
customName: TEdit;
Label4: TLabel;
ChnName: TEdit;
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
ADOQueryTmp: TADOQuery;
DataSource1: TDataSource;
V1operTime: TcxGridDBColumn;
V1customname: TcxGridDBColumn;
V1P_Code: TcxGridDBColumn;
V1P_ChnName: TcxGridDBColumn;
V1P_Spec: TcxGridDBColumn;
V1packs: TcxGridDBColumn;
V1P_Num: TcxGridDBColumn;
V1P_unit: TcxGridDBColumn;
V1operatorName: TcxGridDBColumn;
V1note: TcxGridDBColumn;
Panetime: TPanel;
ADOQueryCmd: TADOQuery;
V1planNo: TcxGridDBColumn;
Label5: TLabel;
planNo: TEdit;
tbLook: TToolButton;
V1colorname: TcxGridDBColumn;
V1P_YHNO: TcxGridDBColumn;
V1P_Colstd: TcxGridDBColumn;
cxGridPopupMenu1: TcxGridPopupMenu;
Label6: TLabel;
userID: TEdit;
userName: TEdit;
Label7: TLabel;
tbPrintlb: TToolButton;
ToolButton1: TToolButton;
dxComponentPrinter1: TdxComponentPrinter;
dxComponentPrinter1Link1: TdxGridReportLink;
procedure tbcloseClick(Sender: TObject);
procedure tbaddClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure tbselectClick(Sender: TObject);
procedure tbupdateClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure tbdeleteClick(Sender: TObject);
procedure tbLookClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure tbPrintlbClick(Sender: TObject);
private
procedure DoQuery();
procedure FilterData();
function DeleteData():boolean; //删除数据
procedure initGrid();
{ Private declarations }
public
FType:string;
{ Public declarations }
end;
var
frmClList: TfrmClList;
implementation
uses
U_DataLink,U_Fun; //, U_ClEdit
{$R *.dfm}
procedure TfrmClList.initGrid();
var
i:integer;
begin
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add(' select * from BD_ColumnConfig ');
sql.Add(' where tableName=''WS_Register'' ');
sql.Add(' and Type='''+trim(fType)+''' ');
sql.Add(' and isVisibleLB=1 ');
sql.Add(' order by orderNo ');
open;
end;
TV1.ClearItems;
if not adoqueryCmd.IsEmpty then
begin
for i:=0 to adoqueryCmd.RecordCount-1 do
begin
tv1.CreateColumn;
tv1.Columns[i].DataBinding.FieldName:=trim(adoqueryCmd.fieldbyname('col').AsString);
tv1.Columns[i].Caption:=trim(adoqueryCmd.fieldbyname('colName').AsString);
tv1.Columns[i].Name:='tv1'+trim(adoqueryCmd.fieldbyname('col').AsString);
tv1.Columns[i].HeaderAlignmentHorz:=tacenter;
tv1.Columns[i].Width:=90;
if LeftBStr(trim(adoqueryCmd.fieldbyname('col').AsString),2) ='fd' then
tv1.Columns[i].Summary.FooterKind:=sksum;
// if adoqueryCmd.fieldbyname('isreadonly').AsBoolean then
// tv1.Columns[i].Options.Editing:=false;
adoqueryCmd.Next;
end;
end;
//TV1.ApplyBestFit();
end;
//////////////////////////////////////////////
//////删除数据
//////////////////////////////////////////////
function TfrmClList.DeleteData():boolean;
begin
result:=false;
try
with adoqueryCmd do
begin
close;
sql.Clear;
// sql.Add('delete from JD_Inspect where InspectNo='+quotedstr(trim(ADOQueryTmp.fieldbyname('InspectNo').AsString)));
sql.Add('delete from WS_Register where WRNo='+quotedstr(trim(ADOQueryTmp.fieldbyname('WRNo').AsString)));
sql.Add('and WRID='+quotedstr(trim(ADOQueryTmp.fieldbyname('WRID').AsString)));
execsql;
end;
result:=true;
except
end;
end;
procedure TfrmClList.DoQuery();
var
strsql,sqlwhere:string;
begin
begdate.SetFocus;
screen.Cursor:=crsqlwait;
Panetime.Visible:=true;
Panetime.Left:=(Width-Panetime.Width) div 2;
Panetime.top:=(Height-Panetime.Height-400) div 2;
Application.ProcessMessages;
sqlwhere:=' where WRDate>='''+formatdatetime('yyyy-MM-dd',begdate.Date)+''' '+
' and WRDate<'''+formatdatetime('yyyy-MM-dd',enddate.Date+1)+''' ';
sqlwhere:=sqlwhere+' and Type='''+trim(FType)+''' ';
try
with ADOQueryTmp do
begin
close;
sql.Clear;
filtered:=false;
sql.Add('select * from WS_Register A');
sql.Add(sqlwhere);
open;
end;
FilterData();
finally
Panetime.Visible:=false;
screen.Cursor:=crdefault;
end;
end;
procedure TfrmClList.FilterData();
var
filterStr:string;
begin
filterStr:='';
if trim(userID.Text)<>'' then
filterStr:=filterStr+' and userID like '+quotedstr('%'+trim(userID.Text)+'%');
if trim(USERName.Text)<>'' then
filterStr:=filterStr+' and USERName like '+quotedstr('%'+trim(USERName.Text)+'%');
if trim(planNo.Text)<>'' then
filterStr:=filterStr+' and planNo like '+quotedstr('%'+trim(planNo.Text)+'%');
try
ADOQueryTmp.DisableControls ;
if trim(filterStr)='' then
begin
ADOQueryTmp.Filtered:=false;
ADOQueryTmp.EnableControls;
exit;
end;
filterStr:=trim(Copy(filterStr,5,length(filterStr)-4));
with ADOQueryTmp do
begin
filtered:=false;
filter:=filterStr;
filtered:=true;
end;
finally
ADOQueryTmp.EnableControls;
end;
end;
procedure TfrmClList.tbcloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmClList.tbaddClick(Sender: TObject);
begin
// frmclEdit:=TfrmclEdit.create(self);
// with frmclEdit do
// begin
// fromid:=0;
// fType:=trim(self.FType);
// caption:=trim(self.Caption);
// if showmodal=1 then
// begin
// // DoQuery();
// // self.ADOQueryTmp.Locate('inspectNo',fkeyNO,[]);
// end;
// DoQuery();
// Release;
// end;
end;
procedure TfrmClList.FormDestroy(Sender: TObject);
begin
frmClList:=nil;
end;
procedure TfrmClList.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
writeCxGrid(self.Name+tv1.Name+Self.FType,tv1,'产量登记');
action:=cafree;
end;
procedure TfrmClList.FormCreate(Sender: TObject);
begin
begdate.Date:=dServerDate-6;
enddate.Date:=dServerDate;
cxgrid1.Align:=alClient;
end;
procedure TfrmClList.tbselectClick(Sender: TObject);
begin
DoQuery();
end;
procedure TfrmClList.tbupdateClick(Sender: TObject);
begin
// if ADOQueryTmp.IsEmpty then exit;
// frmclEdit:=TfrmclEdit.create(self);
// with frmclEdit do
// begin
// fromid:=1;
// fType:=trim(self.FType);
// caption:=trim(self.Caption);
// fkeyNO:=trim(self.ADOQueryTmp.fieldbyname('WRNO').AsString);
// if showmodal=1 then
// begin
// DoQuery();
// self.ADOQueryTmp.Locate('WRNO',fkeyNO,[]);
// end;
// Release;
// end;
end;
procedure TfrmClList.FormShow(Sender: TObject);
begin
initGrid();
readCxGrid(self.Name+tv1.Name+Self.FType,tv1,'产量登记');
DoQuery();
end;
procedure TfrmClList.tbdeleteClick(Sender: TObject);
begin
if adoqueryTmp.IsEmpty then exit;
if application.MessageBox('是否删除此信息？','提示信息',MB_YesNo+MB_DefButton2+MB_IconQuestion)=IdYes then
begin
if not DeleteData() then
begin
application.MessageBox('删除数据失败！','提示信息');
exit;
end;
DoQuery();
end;
end;
procedure TfrmClList.tbLookClick(Sender: TObject);
begin
// if ADOQueryTmp.IsEmpty then exit;
// frmclEdit:=TfrmclEdit.create(self);
// with frmclEdit do
// begin
// fromid:=10;
// fType:=trim(self.FType);
// fkeyNO:=trim(self.ADOQueryTmp.fieldbyname('WRNO').AsString);
// caption:=trim(self.Caption);
// if showmodal=1 then
// begin
// DoQuery();
// self.ADOQueryTmp.Locate('inspectNo',fkeyNO,[]);
// end;
// Release;
// end;
end;
procedure TfrmClList.TV1DblClick(Sender: TObject);
begin
tbLook.Click;
end;
procedure TfrmClList.ToolButton1Click(Sender: TObject);
begin
if ADOQueryTmp.IsEmpty then exit;
TcxGridToExcel(self.Caption,cxGrid1);
end;
procedure TfrmClList.tbPrintlbClick(Sender: TObject);
begin
if ADOQueryTmp.IsEmpty then exit;
dxComponentPrinter1.ReportLink[0].Preview;
end;
end.

18215
Z99Dependency/ThreeFun/Form/U_ColumnBandSet.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

467
Z99Dependency/ThreeFun/Form/U_ColumnBandSet.pas Normal file
View File

@ -0,0 +1,467 @@
unit U_ColumnBandSet;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, cxCheckBox, ADODB, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, ComCtrls, ToolWin,
ImgList;
type
TfrmColumnBandSet = class(TForm)
ToolBar1: TToolBar;
TBTP: TToolButton;
TBClose: TToolButton;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
v2Column1: TcxGridDBColumn;
ClientDataSet1: TClientDataSet;
ClientDataSet2: TClientDataSet;
DataSource1: TDataSource;
DataSource2: TDataSource;
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
ADOQuery3: TADOQuery;
ADOQuery4: 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;
FenHongS: TcxStyle;
cxGrid3: TcxGrid;
Tv3: TcxGridDBTableView;
cxGridDBColumn3: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
DSName: TDataSource;
CDSName: TClientDataSet;
ADOQuery5: TADOQuery;
v2Column2: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure TBTPClick(Sender: TObject);
procedure Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure SCreateCDS200(SADOQry:TADOQuery; mClientDataset:TclientDataSet );
procedure SInitCDSData200(fromADO:TADOQuery;toCDS:TclientDataSet);
function GetLSNo200(ADOQueryTmp:TADOQuery;
var mMaxNo:string;
mFlag:string;
mTable:string;
mlen:integer;
mtype:integer=0):Boolean;
public
MKName:String;
{ Public declarations }
end;
var
frmColumnBandSet: TfrmColumnBandSet;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmColumnBandSet.FormDestroy(Sender: TObject);
begin
frmColumnBandSet:=nil;
end;
procedure TfrmColumnBandSet.SCreateCDS200(SADOQry:TADOQuery; mClientDataset:TclientDataSet );
var
i:integer;
mfieldName:string;
mSize:integer;
begin
mfieldName:='';
mClientDataset.FieldDefs.Clear;
with SADOQry do
begin
for i:=0 to fieldCount-1 do //
begin
if (Fields[i].DataType=ftString) and (Fields[i].Size=0) then
begin
msize:=1;
end
else
msize:=Fields[i].Size;
mfieldName:=trim(fields[i].FieldName);
mClientDataset.FieldDefs.Add(mfieldName,
Fields[i].DataType,msize);
end;
end;
mClientDataset.FieldDefs.Add('Sflag',ftString,1);
mClientDataset.FieldDefs.Add('Sindex',ftInteger,0);
mClientDataset.FieldDefs.Add('Ssel',ftBoolean,0);
mClientDataset.FieldDefs.Add('SDefNote',ftString,10);
mClientDataset.Close;
mClientDataset.CreateDataSet;
end;
procedure TfrmColumnBandSet.SInitCDSData200(fromADO:TADOQuery;toCDS:TclientDataSet);
var
i:integer;
k:integer;
begin
if fromADO.IsEmpty then exit;
fromADO.first;
K:=1;
try
toCDS.DisableControls;
toCDS.Filtered:=false;
while not fromADO.Eof do
begin
with toCDS do
begin
Append;
for i:=0 to fromADO.FieldCount-1 do
begin
fields[i].value:=fromADO.Fields[i].Value ;
end;
fieldByName('Sflag').AsString :='1';
fieldByName('Sindex').value :=k;
fieldByName('Ssel').value :=false;
inc(k);
Post;
end;
fromADO.Next;
end;
if not toCDS.IsEmpty then
begin
toCDS.First ;
end;
finally
toCDS.EnableControls;
end;
end;
procedure TfrmColumnBandSet.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmColumnBandSet.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmColumnBandSet.FormShow(Sender: TObject);
begin
try
ADOQuery1.DisableControls;
with ADOQuery1 do
begin
Close;
sql.Clear;
SQL.Add('select * from SY_User where UserId<>''Admin'' ');
Open;
end;
SCreateCDS200(ADOQuery1,ClientDataSet1);
SInitCDSData200(ADOQuery1,ClientDataSet1);
finally
ADOQuery1.EnableControls;
end;
end;
procedure TfrmColumnBandSet.TBTPClick(Sender: TObject);
var
MaxNo:String;
begin
if ClientDataSet1.IsEmpty then Exit;
if ClientDataSet1.Locate('SSel',True,[])=False then Exit;
try
ADOQuery3.Connection.BeginTrans;
if ClientDataSet1.Locate('SSel',True,[])=True then
begin
with ClientDataSet1 do
begin
First;
while not eof do
begin
if ClientDataSet1.FieldByName('SSel').AsBoolean=True then
begin
with ADOQuery3 do
begin
Close;
sql.Clear;
sql.Add('Delete Table_Column where ');
sql.Add(' Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
ExecSQL;
end;
with ADOQuery3 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Column where 1<>1 ');
open;
end;
ClientDataSet2.DisableControls;
with ClientDataSet2 do
begin
first;
while not Eof do
begin
with ADOQuery3 do
begin
Append;
if GetLSNo200(ADOQuery4,MaxNo,'CL','Table_Column',4,1)=False then
begin
ADOQuery3.Connection.RollbackTrans;
Application.MessageBox('取最大号失败！','提示',0);
Exit;
end;
FieldByName('TCID').Value:=Trim(MaxNo);
FieldByName('Owner').Value:=Trim(ClientDataSet1.fieldbyname('UserId').AsString);
//SSetSaveDataCDSNew(ADOQuery3,Tv2,ClientDataSet2,'Table_Column',0);
FieldByName('CxTabName').Value:=Trim(ClientDataSet2.fieldbyname('CxTabName').AsString);
FieldByName('CxColName').Value:=Trim(ClientDataSet2.fieldbyname('CxColName').AsString);
if ClientDataSet2.fieldbyname('TCNotVisble').AsBoolean=True then
FieldByName('TCNotVisble').Value:=1
else
FieldByName('TCNotVisble').Value:=0;
FieldByName('ColName').Value:=Trim(ClientDataSet2.fieldbyname('ColName').AsString);
FieldByName('OrderNo').Value:=ClientDataSet2.fieldbyname('OrderNo').Value;
FieldByName('FillTime').Value:=Now;
Post;
end;
Next;
end;
end;
ClientDataSet2.EnableControls;
end;
Next;
end;
end;
if ClientDataSet1.Locate('SSel',True,[])=True then
begin
with ClientDataSet1 do
begin
First;
while not eof do
begin
if ClientDataSet1.FieldByName('SSel').AsBoolean=True then
begin
with ADOQuery3 do
begin
Close;
sql.Clear;
sql.Add(' Delete Table_Name where');
sql.Add(' Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
ExecSQL;
end;
with ADOQuery3 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Name where 1<>1 ');
open;
end;
CDSName.DisableControls;
with CDSName do
begin
First;
while not eof do
begin
with ADOQuery3 do
begin
Append;
FieldByName('Owner').Value:=Trim(ClientDataSet1.fieldbyname('UserId').AsString);
FieldByName('CxTabName').Value:=Trim(CDSName.fieldbyname('CxTabName').AsString);
if CDSName.fieldbyname('TCNotVisble').AsBoolean=True then
FieldByName('TCNotVisble').Value:=1
else
FieldByName('TCNotVisble').Value:=0;
if CDSName.fieldbyname('InPut').AsBoolean=True then
FieldByName('InPut').Value:=1
else
FieldByName('InPut').Value:=0;
FieldByName('FillTime').Value:=Now;
FieldByName('OrderNo').Value:=CDSName.fieldbyname('OrderNo').Value;
Post;
end;
next;
end;
end;
CDSName.EnableControls;
end;
Next;
end;
end;
end;
end;
ADOQuery3.Connection.CommitTrans;
Application.MessageBox('保存成功！','提示',0);
except
ADOQuery3.Connection.RollbackTrans;
Application.MessageBox('保存失败！','提示',0);
end;
end;
function TfrmColumnBandSet.GetLSNo200(ADOQueryTmp:TADOQuery;
var mMaxNo:string;
mFlag:string;
mTable:string;
mlen:integer;
mtype:integer=0):Boolean;
begin
try
with ADOQueryTmp do
begin
Close;
sql.Clear ;
sql.Add('exec Get_SY_MaxBH ');
sql.Add(' '+quotedStr(mFlag));
sql.Add(','+quotedStr(mTable));
sql.Add(','+intTostr(mlen));
sql.Add(','+intTostr(mtype));
//ShowMessage(SQL.Text);
Open;
if RecordCount>0 then
begin
mMaxNo:=trim(fieldByName('MaxBH').AsString) ;
if mMaxNo<>'' then
result:=true
else
Result:=false;
end
else
begin
result:=false;
end;
end;
if not Result then
application.MessageBox(Pchar('无法生成流水号('+mflag+')'),'提示信息',MB_ICONINFORMATION);
Except
result:=false;
application.MessageBox(Pchar('无法生成流水号('+mflag+')'),'提示信息',MB_ICONINFORMATION);
end;
end;
procedure TfrmColumnBandSet.Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
ADOQuery2.DisableControls;
with ADOQuery2 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Column where ');
sql.Add(' Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
Open;
end;
if ADOQuery2.IsEmpty=False then
begin
with ADOQuery2 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Column where ');
sql.Add(' Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
sql.Add(' order by OrderNo ');
Open;
end;
SCreateCDS200(ADOQuery2,ClientDataSet2);
SInitCDSData200(ADOQuery2,ClientDataSet2);
end else
begin
while ClientDataSet2.Locate('TCNotVisble',True,[]) do
begin
with ClientDataSet2 do
begin
Edit;
FieldByName('TCNotVisble').Value:=0;
Post;
end;
end;
end;
ADOQuery2.EnableControls;
ADOQuery5.DisableControls;
with ADOQuery5 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Name where ');
sql.Add(' Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
Open;
end;
if ADOQuery5.IsEmpty=False then
begin
with ADOQuery5 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Name where ');
sql.Add(' Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
sql.Add(' order by OrderNo ');
Open;
end;
SCreateCDS200(ADOQuery5,CDSName);
SInitCDSData200(ADOQuery5,CDSName);
end else
begin
while CDSName.Locate('TCNotVisble',True,[]) do
begin
with CDSName do
begin
Edit;
FieldByName('TCNotVisble').Value:=0;
FieldByName('InPut').Value:=0;
Post;
end;
end;
end;
ADOQuery5.EnableControls;
end;
procedure TfrmColumnBandSet.FormCreate(Sender: TObject);
begin
with ADOLink do
begin
if not Connected then
begin
Connected:=false;
ConnectionString:=DConString;
//LoginPrompt:=false;
Connected:=true;
end;
end;
end;
end.

18157
Z99Dependency/ThreeFun/Form/U_ColumnSet.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

347
Z99Dependency/ThreeFun/Form/U_ColumnSet.pas Normal file
View File

@ -0,0 +1,347 @@
unit U_ColumnSet;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, cxCheckBox, ADODB, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, ComCtrls, ToolWin,
ImgList;
type
TfrmColumnSet = class(TForm)
ToolBar1: TToolBar;
TBTP: TToolButton;
TBClose: TToolButton;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
v2Column1: TcxGridDBColumn;
ClientDataSet1: TClientDataSet;
ClientDataSet2: TClientDataSet;
DataSource1: TDataSource;
DataSource2: TDataSource;
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
ADOQuery3: TADOQuery;
ADOQuery4: 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;
FenHongS: TcxStyle;
procedure FormDestroy(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure TBTPClick(Sender: TObject);
procedure Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure SCreateCDS200(SADOQry:TADOQuery; mClientDataset:TclientDataSet );
procedure SInitCDSData200(fromADO:TADOQuery;toCDS:TclientDataSet);
function GetLSNo200(ADOQueryTmp:TADOQuery;
var mMaxNo:string;
mFlag:string;
mTable:string;
mlen:integer;
mtype:integer=0):Boolean;
public
MKName:String;
{ Public declarations }
end;
var
frmColumnSet: TfrmColumnSet;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmColumnSet.FormDestroy(Sender: TObject);
begin
frmColumnSet:=nil;
end;
procedure TfrmColumnSet.SCreateCDS200(SADOQry:TADOQuery; mClientDataset:TclientDataSet );
var
i:integer;
mfieldName:string;
mSize:integer;
begin
mfieldName:='';
mClientDataset.FieldDefs.Clear;
with SADOQry do
begin
for i:=0 to fieldCount-1 do //
begin
if (Fields[i].DataType=ftString) and (Fields[i].Size=0) then
begin
msize:=1;
end
else
msize:=Fields[i].Size;
mfieldName:=trim(fields[i].FieldName);
mClientDataset.FieldDefs.Add(mfieldName,
Fields[i].DataType,msize);
end;
end;
mClientDataset.FieldDefs.Add('Sflag',ftString,1);
mClientDataset.FieldDefs.Add('Sindex',ftInteger,0);
mClientDataset.FieldDefs.Add('Ssel',ftBoolean,0);
mClientDataset.FieldDefs.Add('SDefNote',ftString,10);
mClientDataset.Close;
mClientDataset.CreateDataSet;
end;
procedure TfrmColumnSet.SInitCDSData200(fromADO:TADOQuery;toCDS:TclientDataSet);
var
i:integer;
k:integer;
begin
if fromADO.IsEmpty then exit;
fromADO.first;
K:=1;
try
toCDS.DisableControls;
toCDS.Filtered:=false;
while not fromADO.Eof do
begin
with toCDS do
begin
Append;
for i:=0 to fromADO.FieldCount-1 do
begin
fields[i].value:=fromADO.Fields[i].Value ;
end;
fieldByName('Sflag').AsString :='1';
fieldByName('Sindex').value :=k;
fieldByName('Ssel').value :=false;
inc(k);
Post;
end;
fromADO.Next;
end;
if not toCDS.IsEmpty then
begin
toCDS.First ;
end;
finally
toCDS.EnableControls;
end;
end;
procedure TfrmColumnSet.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmColumnSet.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmColumnSet.FormShow(Sender: TObject);
begin
try
ADOQuery1.DisableControls;
with ADOQuery1 do
begin
Close;
sql.Clear;
SQL.Add('select * from SY_User where UserId<>''Admin'' ');
Open;
end;
SCreateCDS200(ADOQuery1,ClientDataSet1);
SInitCDSData200(ADOQuery1,ClientDataSet1);
finally
ADOQuery1.EnableControls;
end;
end;
procedure TfrmColumnSet.TBTPClick(Sender: TObject);
var
MaxNo:String;
begin
if ClientDataSet1.Locate('SSel',True,[])=False then Exit;
try
ADOQuery3.Connection.BeginTrans;
with ClientDataSet1 do
begin
First;
while not eof do
begin
if ClientDataSet1.FieldByName('SSel').AsBoolean=True then
begin
with ADOQuery3 do
begin
Close;
sql.Clear;
sql.Add('Delete Table_Column where CxTabName='''+Trim(ClientDataSet2.fieldbyname('CxTabName').AsString)+'''');
sql.Add(' and Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
ExecSQL;
end;
with ADOQuery3 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Column where 1<>1 ');
open;
end;
with ClientDataSet2 do
begin
first;
while not Eof do
begin
with ADOQuery3 do
begin
Append;
if GetLSNo200(ADOQuery4,MaxNo,'CL','Table_Column',4,1)=False then
begin
ADOQuery3.Connection.RollbackTrans;
Application.MessageBox('取最大号失败！','提示',0);
Exit;
end;
FieldByName('TCID').Value:=Trim(MaxNo);
FieldByName('Owner').Value:=Trim(ClientDataSet1.fieldbyname('UserId').AsString);
//SSetSaveDataCDSNew(ADOQuery3,Tv2,ClientDataSet2,'Table_Column',0);
FieldByName('CxTabName').Value:=Trim(ClientDataSet2.fieldbyname('CxTabName').AsString);
FieldByName('CxColName').Value:=Trim(ClientDataSet2.fieldbyname('CxColName').AsString);
FieldByName('TCNotVisble').Value:=ClientDataSet2.fieldbyname('TCNotVisble').Value;
FieldByName('ColName').Value:=Trim(ClientDataSet2.fieldbyname('ColName').AsString);
Post;
end;
Next;
end;
end;
end;
Next;
end;
end;
ADOQuery3.Connection.CommitTrans;
Application.MessageBox('保存成功！','提示',0);
except
ADOQuery3.Connection.RollbackTrans;
Application.MessageBox('保存失败！','提示',0);
end;
end;
function TfrmColumnSet.GetLSNo200(ADOQueryTmp:TADOQuery;
var mMaxNo:string;
mFlag:string;
mTable:string;
mlen:integer;
mtype:integer=0):Boolean;
begin
try
with ADOQueryTmp do
begin
Close;
sql.Clear ;
sql.Add('exec Get_SY_MaxBH ');
sql.Add(' '+quotedStr(mFlag));
sql.Add(','+quotedStr(mTable));
sql.Add(','+intTostr(mlen));
sql.Add(','+intTostr(mtype));
//ShowMessage(SQL.Text);
Open;
if RecordCount>0 then
begin
mMaxNo:=trim(fieldByName('MaxBH').AsString) ;
if mMaxNo<>'' then
result:=true
else
Result:=false;
end
else
begin
result:=false;
end;
end;
if not Result then
application.MessageBox(Pchar('无法生成流水号('+mflag+')'),'提示信息',MB_ICONINFORMATION);
Except
result:=false;
application.MessageBox(Pchar('无法生成流水号('+mflag+')'),'提示信息',MB_ICONINFORMATION);
end;
end;
procedure TfrmColumnSet.Tv1CellClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
ADOQuery2.DisableControls;
with ADOQuery2 do
begin
Close;
sql.Clear;
sql.Add('select * from Table_Column where CxTabName='''+Trim(ClientDataSet2.fieldbyname('CxTabName').AsString)+'''');
sql.Add(' and Owner='''+Trim(ClientDataSet1.fieldbyname('UserId').AsString)+'''');
Open;
end;
if ADOQuery2.IsEmpty=False then
begin
SCreateCDS200(ADOQuery2,ClientDataSet2);
SInitCDSData200(ADOQuery2,ClientDataSet2);
end else
begin
while ClientDataSet2.Locate('TCNotVisble',True,[]) do
begin
with ClientDataSet2 do
begin
Edit;
FieldByName('TCNotVisble').Value:=0;
Post;
end;
end;
end;
ADOQuery2.EnableControls;
end;
procedure TfrmColumnSet.FormCreate(Sender: TObject);
begin
with ADOLink do
begin
if not Connected then
begin
Connected:=false;
ConnectionString:=DConString;
//LoginPrompt:=false;
Connected:=true;
end;
end;
end;
end.

88
Z99Dependency/ThreeFun/Form/U_CompressionFun.pas Normal file
View File

@ -0,0 +1,88 @@
unit U_CompressionFun;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, ShlObj, cxShellCommon, cxControls,
cxContainer, cxShellTreeView, cxShellListView, StdCtrls, BtnEdit,
OleCtnrs, DB, ADODB,ZLib;
procedure CompressionStream(var ASrcStream:TMemoryStream;ACompressionLevel:Integer = 2);
procedure UnCompressionStream(var ASrcStream:TMemoryStream);
implementation
uses
U_iniparam;
////////////////////////////////////////////////////
///////压缩流
////////////////////////////////////////////////////
procedure CompressionStream(var ASrcStream:TMemoryStream;ACompressionLevel:Integer = 2);
var
nDestStream:TMemoryStream;
nTmpStream:TCompressionStream;
nCompressionLevel:TCompressionLevel;
begin
ASrcStream.Position := 0;
nDestStream := TMemoryStream.Create;
try
//级别
case ACompressionLevel of
0:nCompressionLevel := clNone;
1:nCompressionLevel := clFastest;
2:nCompressionLevel := clDefault;
3:nCompressionLevel := clMax;
else
nCompressionLevel := clMax;
end;
//开始压缩
nTmpStream := TCompressionStream.Create(nCompressionLevel,nDestStream);
try
ASrcStream.SaveToStream(nTmpStream);
finally
nTmpStream.Free;//释放后nDestStream才会有数据
end;
ASrcStream.Clear;
ASrcStream.LoadFromStream(nDestStream);
ASrcStream.Position := 0;
finally
nDestStream.Clear;
nDestStream.Free;
end;
end;
////////////////////////////////////////////////////
///////解压缩流
////////////////////////////////////////////////////
procedure UnCompressionStream(var ASrcStream:TMemoryStream);
var
nTmpStream:TDecompressionStream;
nDestStream:TMemoryStream;
nBuf: array[1..512] of Byte;
nSrcCount: integer;
begin
ASrcStream.Position := 0;
nDestStream := TMemoryStream.Create;
nTmpStream := TDecompressionStream.Create(ASrcStream);
try
repeat
//读入实际大小
nSrcCount := nTmpStream.Read(nBuf, SizeOf(nBuf));
if nSrcCount > 0 then
nDestStream.Write(nBuf, nSrcCount);
until (nSrcCount = 0);
ASrcStream.Clear;
ASrcStream.LoadFromStream(nDestStream);
ASrcStream.Position := 0;
finally
nDestStream.Clear;
nDestStream.Free;
nTmpStream.Free;
end;
end;
end.

18042
Z99Dependency/ThreeFun/Form/U_DxZDYHelp.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

310
Z99Dependency/ThreeFun/Form/U_DxZDYHelp.pas Normal file
View File

@ -0,0 +1,310 @@
unit U_DxZDYHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxCheckBox, cxDropDownEdit;
type
TfrmDxZDYHelp = class(TForm)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
V1Code: TcxGridDBColumn;
V1Name: TcxGridDBColumn;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
TBAdd: TToolButton;
TBSave: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
TBEdit: TToolButton;
V1Note: TcxGridDBColumn;
V1OrderNo: TcxGridDBColumn;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
ZDYName: TEdit;
ThreeImgList: TImageList;
V1Sel: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBAddClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure ZDYNameChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
flag,flagname,snote:string;
fnote,forderno:Boolean;
Mresult:string;
{ Public declarations }
end;
var
frmDxZDYHelp: TfrmDxZDYHelp;
implementation
uses
U_DataLink,U_Fun10, U_ZDYHelp;
{$R *.dfm}
procedure TfrmDxZDYHelp.FormCreate(Sender: TObject);
begin
cxGrid1.Align:=alClient;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
Connected:=true;
end;
end;
procedure TfrmDxZDYHelp.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=cahide;
end;
procedure TfrmDxZDYHelp.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where Type='''+flag+'''');
Open;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmDxZDYHelp.TBAddClick(Sender: TObject);
begin
v1name.Options.Editing:=true;
//TV1.OptionsData.Editing:=True;
with ClientDataSet1 do
begin
Append;
Post;
end;
end;
procedure TfrmDxZDYHelp.TBSaveClick(Sender: TObject);
var
maxno:string;
begin
if ClientDataSet1.IsEmpty then Exit;
try
ADOQueryCmd.Connection.BeginTrans;
{with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete KH_ZDY where Type='''+Trim(Flag)+'''');
SQL.Add('delete KH_ZDY where ZDYNo='''+Trim(Flag)+'''');
sql.Add('insert into KH_ZDY(ZDYNo,ZDYName,Type) select :ZDYNo,:ZDYName,:Type ');
Parameters.ParamByName('ZDYNo').Value:=Trim(flag);
Parameters.ParamByName('ZDYName').Value:=Trim(flagname);
Parameters.ParamByName('Type').Value:='Main';
ExecSQL;
end;}
with ADOQueryCmd do
begin
with ClientDataSet1 do
begin
First;
while not eof do
begin
if Trim(ClientDataSet1.FieldByName('ZDYNO').AsString)='' then
begin
if GetLSNo(ADOQueryTemp,maxno,'SY','KH_ZDY',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大编号失败！','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add('delete KH_ZDY where ZDYNO='''+Trim(ClientDataSet1.fieldbyname('ZDYNO').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where 1<>1');
Open;
end;
if Trim(ClientDataSet1.FieldByName('ZDYName').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('名称不能为空！','提示',0);
Exit;
end;
ADOQueryCmd.Append;
ADOQueryCmd.FieldByName('ZDYNo').Value:=Trim(maxno);
ADOQueryCmd.FieldByName('ZDYName').Value:=ClientDataSet1.fieldbyname('ZDYName').AsString;
ADOQueryCmd.FieldByName('note').Value:=Trim(ClientDataSet1.fieldbyname('note').AsString);
//ADOQueryCmd.FieldByName('orderno').Value:=ClientDataSet1.fieldbyname('Name').AsString;
ADOQueryCmd.FieldByName('Type').Value:=flag;
ADOQueryCmd.FieldByName('valid').Value:='Y';
//ADOQueryCmd.FieldByName('sel').Value:=0;
ADOQueryCmd.Post;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('ZDYNo').Value:=Trim(maxno);
ClientDataSet1.Post;
Next;
end;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功！','提示',0);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败！','提示',0);
end;
V1Name.Options.Editing:=false;
end;
procedure TfrmDxZDYHelp.TBDelClick(Sender: TObject);
begin
if ClientDataSet1.IsEmpty then Exit;
if (Trim(ClientDataSet1.FieldByName('ZDYNo').AsString)<>'') or
(Trim(ClientDataSet1.FieldByName('ZDYname').AsString)<>'') then
begin
if application.MessageBox('确定要删除吗?','提示信息',1)=2 then exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete KH_ZDY where ZDYNo='''+Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString)+'''');
SQL.Add(' and Type='''+Trim(flag)+'''');
ExecSQL;
end;
end;
ClientDataSet1.Delete;
end;
procedure TfrmDxZDYHelp.TBCloseClick(Sender: TObject);
begin
ModalResult:=2;
Close;
end;
procedure TfrmDxZDYHelp.FormShow(Sender: TObject);
var
fsj,fsj1:string;
begin
InitGrid();
fsj:=Trim(flag)+'01';
fsj1:=Trim(flagname)+'01';
{if ClientDataSet1.IsEmpty then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into KH_ZDY(ZDYNo,ZDYname,Type,note)');
sql.Add('select '''+Trim(fsj)+'''');
sql.Add(','''+Trim(fsj1)+'''');
SQL.Add(','''+Trim(flag)+'''');
sql.Add(','''+Trim(snote)+'''');
ExecSQL;
end;
InitGrid();
end;}
frmDxZDYHelp.Caption:=Trim(flagname)+'<'+Trim(flag)+'>';
end;
procedure TfrmDxZDYHelp.ToolButton1Click(Sender: TObject);
var
ftype:string;
i:integer;
begin
i:=0;
with ClientDataSet1 do
begin
Mresult:='';
First;
DisableControls;
while not eof do
begin
if fieldbyname('Ssel').AsBoolean then
begin
if (i=1) and (ftype<>trim(fieldbyname('note').AsString)) then
begin
application.MessageBox('备注信息不同，不能选择！','提示信息',0);
EnableControls;
exit;
end;
Mresult:=Mresult+trim(fieldbyname('zdyname').AsString)+';';
ftype:=trim(fieldbyname('note').AsString);
i:=1;
end;
next;
end;
First;
EnableControls;
end;
ModalResult:=1;
end;
procedure TfrmDxZDYHelp.TBEditClick(Sender: TObject);
begin
v1name.Options.Editing:=true;
// TV1.OptionsData.Editing:=True;
end;
procedure TfrmDxZDYHelp.TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if v1name.Options.Editing=False then
begin
ToolButton1.Click;
end;
end;
procedure TfrmDxZDYHelp.ZDYNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
end;
end;
end.

86
Z99Dependency/ThreeFun/Form/U_FilterHelp.dfm Normal file
View File

@ -0,0 +1,86 @@
object frmFilterHelp: TfrmFilterHelp
Left = 287
Top = 145
BorderStyle = bsDialog
Caption = #39640#32423#36807#28388
ClientHeight = 507
ClientWidth = 457
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 12
object ScrollBox1: TScrollBox
Left = 0
Top = 0
Width = 457
Height = 465
Align = alTop
Color = clSkyBlue
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentColor = False
ParentFont = False
TabOrder = 0
object Label1: TLabel
Left = 184
Top = 8
Width = 68
Height = 16
Caption = #36807#28388#26465#20214
Font.Charset = ANSI_CHARSET
Font.Color = clRed
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object CheckBox1: TCheckBox
Left = 384
Top = 8
Width = 57
Height = 17
Caption = #31934#30830
TabOrder = 0
end
end
object Panel1: TPanel
Left = 0
Top = 465
Width = 457
Height = 43
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 1
object Button1: TButton
Left = 112
Top = 9
Width = 75
Height = 25
Caption = #30830#23450
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 264
Top = 9
Width = 75
Height = 25
Caption = #20851#38381
TabOrder = 1
OnClick = Button2Click
end
end
object XPManifest1: TXPManifest
Left = 280
Top = 328
end
end

213
Z99Dependency/ThreeFun/Form/U_FilterHelp.pas Normal file
View File

@ -0,0 +1,213 @@
unit U_FilterHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, cxStyles, cxCustomData, cxGraphics,
cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData,StrUtils,ADODB,
XPMan;
type
TfrmFilterHelp = class(TForm)
ScrollBox1: TScrollBox;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
CheckBox1: TCheckBox;
XPManifest1: TXPManifest;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
procedure CreateFilers(Tv1:TcxGridDBTableView);
function GSGetFilters():string;
procedure GSQryDofilter(ADOQry:TADOQuery;FilterStr:string);
procedure TcxGridToExcel(mfileName:string;gridName:TcxGrid);
{ Public declarations }
end;
var
frmFilterHelp: TfrmFilterHelp;
implementation
{$R *.dfm}
procedure TfrmFilterHelp.Button1Click(Sender: TObject);
begin
ModalResult:=1
end;
///////////////////////////////////////////////////////////////////
//函数功能：利用cxGrid自带的功能导出到excel中
//////////////////////////////////////////////////////////////////
procedure TfrmFilterHelp.TcxGridToExcel(mfileName:string;gridName:TcxGrid);
var
saveDialog:TSaveDialog;
begin
try
saveDialog:=TSaveDialog.Create(nil);
saveDialog.Filter:='xls(*.xls)|*.xls|全部(*.*)|*.*';
saveDialog.Options:=[ofOverwritePrompt];
saveDialog.FileName:=mfileName;
if saveDialog.Execute then
if Assigned(gridName) then
begin
try
// ExportGrid4ToExcel(saveDialog.FileName,gridName);
except
application.MessageBox('创建失败,源文件可能处于编辑状态!','提示信息',0);
exit;
end;
application.MessageBox('成功导出!','提示信息',0);
end
else
application.MessageBox('导出失败!','提示信息',0);
finally
saveDialog.Free;
end;
end;
procedure TfrmFilterHelp.Button2Click(Sender: TObject);
begin
ModalResult:=-1;
end;
procedure TfrmFilterHelp.CreateFilers(Tv1:TcxGridDBTableView);
var
i,j,z,m,FTop,FLeft,Fdiv,FMod:Integer;// mod 余数，div商
FLableEdit:TLabeledEdit;
begin
j:=0;
for i:=0 to Tv1.ColumnCount-1 do
begin
m:=0;
if Tv1.Columns[i].Visible=False then Continue;
if not ( (Tv1.DataController.DataSource.DataSet.FieldByName(Tv1.Columns[i].DataBinding.FieldName).DataType=ftBCD) or
(Tv1.DataController.DataSource.DataSet.FieldByName(Tv1.Columns[i].DataBinding.FieldName).DataType=ftString) ) then Continue;
Fdiv:=(j+1) div 3;
FMod:=(j+1) mod 3;
FLableEdit:=TLabeledEdit.Create(Self);
FLableEdit.EditLabel.Caption:=Trim(Tv1.Columns[i].Caption);
FLableEdit.Name:=Trim(Tv1.Columns[i].DataBinding.FieldName);
if Tv1.DataController.DataSource.DataSet.FieldByName(Tv1.Columns[i].DataBinding.FieldName).DataType=ftBCD then
begin
FLableEdit.EditLabel.Caption:=Trim(Tv1.Columns[i].Caption+'始');
FLableEdit.Hint:=Trim(Tv1.Columns[i].DataBinding.FieldName);
FLableEdit.Tag:=1;
end;
FLableEdit.Text:='';
FLableEdit.TabOrder:=j;
FLableEdit.Parent:=ScrollBox1;
if FMod>0 then
FLableEdit.Top:=50*(Fdiv+1)
else
FLableEdit.Top:=50*Fdiv;
if FMod=1 then
FLableEdit.Left:=29
else if FMod=2 then
FLableEdit.Left:=163
else if FMod=0 then
FLableEdit.Left:=305;
if Tv1.DataController.DataSource.DataSet.FieldByName(Tv1.Columns[i].DataBinding.FieldName).DataType=ftBCD then
begin
j:=j+1;
Fdiv:=(j+1) div 3;
FMod:=(j+1) mod 3;
FLableEdit:=TLabeledEdit.Create(Self);
FLableEdit.EditLabel.Caption:=Trim(Tv1.Columns[i].Caption+'止');
FLableEdit.Hint:=Trim(Tv1.Columns[i].DataBinding.FieldName);
FLableEdit.Tag:=2;
FLableEdit.Text:='';
FLableEdit.TabOrder:=j;
FLableEdit.Parent:=ScrollBox1;
if FMod>0 then
FLableEdit.Top:=50*(Fdiv+1)
else
FLableEdit.Top:=50*Fdiv;
if FMod=1 then
FLableEdit.Left:=29
else if FMod=2 then
FLableEdit.Left:=163
else if FMod=0 then
FLableEdit.Left:=305;
end;
j:=j+1;
end;
end;
function TfrmFilterHelp.GSGetFilters():string;
var
i:Integer;
FValue:Double;
begin
Result:='';
with ScrollBox1 do
begin
for i:=0 to ControlCount-1 do
begin
if Controls[i] is TLabel then Continue;
if Controls[i] is TLabeledEdit then
begin
if Trim(TLabeledEdit(Controls[i]).Text)<>'' then
begin
if TLabeledEdit(Controls[i]).Tag>0 then
begin
try
FValue:=StrToFloat(TLabeledEdit(Controls[i]).Text);
except
Application.MessageBox('不能输入非法数字！','提示',0);
Exit;
end;
end;
if TLabeledEdit(Controls[i]).Tag=1 then
begin
Result:=Result+'and '+Controls[i].Hint+'>='+Trim(TLabeledEdit(Controls[i]).Text);
end else
if TLabeledEdit(Controls[i]).Tag=2 then
begin
Result:=Result+'and '+Controls[i].Hint+'<='+Trim(TLabeledEdit(Controls[i]).Text);
end else
begin
if CheckBox1.Checked then
Result:=Result+'and '+Controls[i].Name+'='+QuotedStr(Trim(TLabeledEdit(Controls[i]).Text))
else
Result:=Result+'and '+Controls[i].Name+' like '+QuotedStr('%'+Trim(TLabeledEdit(Controls[i]).Text)+'%');
end;
end;
end;
end;
end;
if Trim(Result)<>'' then
Result:=Trim(RightBStr(Result,Length(Result)-4));
end;
procedure TfrmFilterHelp.GSQryDofilter(ADOQry:TADOQuery;FilterStr:string);
begin
try
ADOQry.DisableControls;
with ADOQry do
begin
if Trim(FilterStr)='' then
begin
Filtered:=False;
end else
begin
Filtered:=False;
Filter:=FilterStr;
Filtered:=True;
end;
end;
finally
ADOQry.EnableControls;
end;
end;
end.

132
Z99Dependency/ThreeFun/Form/U_FjList.dfm Normal file
View File

@ -0,0 +1,132 @@
object frmFjList: TfrmFjList
Left = 237
Top = 203
Width = 707
Height = 456
BorderIcons = [biSystemMenu, biMinimize]
Caption = #38468#20214#20449#24687
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ListView1: TListView
Left = 0
Top = 0
Width = 540
Height = 418
Align = alClient
Columns = <>
TabOrder = 0
OnDblClick = ListView1DblClick
end
object Panel1: TPanel
Left = 540
Top = 0
Width = 151
Height = 418
Align = alRight
TabOrder = 1
object FileName: TcxButton
Left = 30
Top = 60
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #28155#21152
TabOrder = 0
OnClick = FileNameClick
LookAndFeel.Kind = lfOffice11
end
object cxButton1: TcxButton
Left = 30
Top = 96
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #21024#38500
TabOrder = 1
OnClick = cxButton1Click
LookAndFeel.Kind = lfOffice11
end
object cxButton2: TcxButton
Left = 30
Top = 132
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #20445#23384
TabOrder = 2
OnClick = cxButton2Click
LookAndFeel.Kind = lfOffice11
end
object cxButton3: TcxButton
Left = 30
Top = 172
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #20851#38381
TabOrder = 3
Visible = False
OnClick = cxButton3Click
LookAndFeel.Kind = lfOffice11
end
end
object Panel2: TPanel
Left = 176
Top = 140
Width = 193
Height = 41
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = 'Panel2'
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
Visible = False
OnDblClick = Panel2DblClick
end
object ADOQueryTmp: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 520
Top = 28
end
object ADOQueryCmd: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 568
Top = 32
end
object ImageList1: TImageList
Left = 536
Top = 228
end
object IdFTP1: TIdFTP
MaxLineAction = maException
ReadTimeout = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
Left = 500
Top = 198
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 532
Top = 240
end
end

393
Z99Dependency/ThreeFun/Form/U_FjList.pas Normal file
View File

@ -0,0 +1,393 @@
unit U_FjList;
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,strutils;
type
TfrmFjList = class(TForm)
ListView1: TListView;
Panel1: TPanel;
FileName: TcxButton;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
ImageList1: TImageList;
Panel2: TPanel;
IdFTP1: TIdFTP;
ADOConnection1: TADOConnection;
procedure cxButton3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FileNameClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel2DblClick(Sender: TObject);
private
procedure InitData();
{ Private declarations }
public
fkeyNO:string;
fType:string;
fId:integer;
fstatus:integer;
{ Public declarations }
end;
var
frmFjList: TfrmFjList;
implementation
uses
U_DataLink,U_Fun10;
{$R *.dfm}
procedure TfrmFjList.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 fileName from TP_File ');
sql.Add('where WBID='+quotedstr(trim(fkeyNO)));
sql.Add('and TFType='+quotedstr(trim(fType)));
open;
if not IsEmpty then
begin
while not eof do
begin
with ListView1 do
begin
LargeImages := ImageList1;
Icon := TIcon.Create;
ListItem := Items.Add;
Listitem.Caption := trim(fieldbyname('fileName').AsString);
// Listitem.SubItems.Add(OpenDiaLog.FileName);
Flag := (SHGFI_SMALLICON or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
SHGetFileInfo(Pchar(trim(fieldbyname('fileName').AsString)), 0, info, Sizeof(info), Flag);
Icon.Handle := info.hIcon;
ImageList1.AddIcon(Icon);
ListItem.ImageIndex := ImageList1.Count - 1;
end;
next;
end;
end;
end;
except
end;
end;
procedure TfrmFjList.cxButton3Click(Sender: TObject);
begin
ADOQueryTmp.Close;
ADOQuerycmd.Close;
ListView1.Items.Free;
ModalResult:=-1;
end;
procedure TfrmFjList.FormDestroy(Sender: TObject);
begin
frmFjList:=nil;
end;
procedure TfrmFjList.FileNameClick(Sender: TObject);
var
OpenDiaLog: TOpenDialog;
fFileName:string;
fFilePath:string;
maxNo:string;
// myStream: TADOBlobStream;
// FJStream : TMemoryStream;
begin
try
OpenDiaLog := TOpenDialog.Create(Self);
if OpenDiaLog.Execute then
begin
fFilePath:=OpenDiaLog.FileName;
fFileName:=ExtractFileName(OpenDiaLog.FileName);
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select TFId from TP_File ');
sql.Add('where WBID<>'+quotedstr(trim(fkeyNO)));
sql.Add('and TFType='+quotedstr(trim(fType)));
sql.Add('and FileName='+quotedstr(trim(fFileName)));
open;
IF not adoqueryCmd.IsEmpty then
begin
application.MessageBox('此附件名称已存在，请修改文件名，继续上传！','提示信息',MB_ICONERROR);
exit;
end;
end;
Panel2.Caption:='正在上传数据，请稍等...';
Panel2.Visible:=true;
application.ProcessMessages;
if GetLSNo(ADOQueryCmd,maxNo,'FJ','TP_File',4,1)=False then
begin
Application.MessageBox('取最大号失败！','提示',0);
Exit;
end;
adoqueryCmd.Connection.BeginTrans;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where WBID='+quotedstr(trim(fkeyNO)));
sql.Add('and TFType='+quotedstr(trim(fType)));
sql.Add('and FileName='+quotedstr(trim(fFileName)));
execsql;
end;
try
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from TP_File ');
sql.Add('where WBID='+quotedstr(trim(fkeyNO)));
sql.Add('and TFType='+quotedstr(trim(fType)));
sql.Add('and FileName='+quotedstr(trim(fFileName)));
open;
append;
fieldbyname('TFID').Value:=trim(maxNO);
fieldbyname('WBID').Value:=trim(fkeyNO);
fieldbyname('TFType').Value:=trim(fType);
fieldbyname('FileName').Value:=trim(fFileName);
// tblobfield(FieldByName('Filesother')).LoadFromFile(fFilePath);
post;
end;
if fFilePath <> '' then
begin
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','FTP地址','127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
IdFTP1.Put(fFilePath, 'FJ\' + Trim(fFileName));
IdFTP1.Quit;
except
IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败，请检查文件服务器！', '提示', MB_ICONWARNING);
end;
end;
IdFTP1.Quit;
Panel2.Visible:=false;
initdata();
finally
// FJStream.Free;
end;
end;
adoqueryCmd.Connection.CommitTrans;
except
adoqueryCmd.Connection.RollbackTrans;
application.MessageBox('附件保存失败！','提示信息',0);
end;
end;
procedure TfrmFjList.FormCreate(Sender: TObject);
begin
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='';
Connected:=true;
end;
ListView1.Align:=alclient;
fstatus:=0;
end;
procedure TfrmFjList.FormShow(Sender: TObject);
begin
IF fstatus=0 then Panel1.Visible:=true
else Panel1.Visible:=false;
initdata();
end;
procedure TfrmFjList.ListView1DblClick(Sender: TObject);
var
sFieldName:string;
fileName:string;
begin
if ListView1.Items.Count<1 THEN EXIT;
if listView1.SelCount<1 then exit;
sFieldName:=leftbstr(ExtractFilePath(Application.ExeName),1)+':\图片查看';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName),nil);
fileName:=ListView1.Selected.Caption;
sFieldName:=sFieldName+'\'+trim(fileName);
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','FTP地址','127.0.0.1');
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,true, false);
except
Panel2.Visible:=false;
Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Panel2.Visible:=false;
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
Panel2.Visible:=false;
if IdFTP1.Connected then IdFTP1.Quit;
ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
end;
procedure TfrmFjList.cxButton1Click(Sender: TObject);
var
fFileName:string;
fFilePath:string;
begin
if listView1.SelCount<1 then exit;
try
fFileName:=ListView1.Selected.Caption;
// ADOQueryTmp.Locate('fileName',fFileName,[]);
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where WBID='+quotedstr(trim(fkeyNO)));
sql.Add('and TFType='+quotedstr(trim(fType)));
sql.Add('and FileName='+quotedstr(trim(fFileName)));
execsql;
end;
initData();
except
end;
end;
procedure TfrmFjList.cxButton2Click(Sender: TObject);
var
SaveDialog: TSaveDialog;
fFileName:string;
fFilePath:string;
begin
if listView1.SelCount<1 then exit;
try
fFileName:=ListView1.Selected.Caption;
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.FileName:=fFileName;
if SaveDialog.Execute then
begin
Panel2.Caption:='正在保存数据，请稍等...';
Panel2.Visible:=true;
application.ProcessMessages;
fFilePath:=SaveDialog.FileName;
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','FTP地址','127.0.0.1');;
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(fFileName), fFilePath,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;
end;
except
Panel2.Visible:=false;
end;
end;
procedure TfrmFjList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if fId=10 then Action:=cafree
else
Action:=cahide;
end;
procedure TfrmFjList.Panel2DblClick(Sender: TObject);
begin
Panel2.Visible:=false;
end;
end.

134
Z99Dependency/ThreeFun/Form/U_FjList10.dfm Normal file
View File

@ -0,0 +1,134 @@
object frmFjList10: TfrmFjList10
Left = 417
Top = 362
Width = 798
Height = 502
BorderIcons = [biSystemMenu, biMinimize]
Caption = #38468#20214#20449#24687
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ListView1: TListView
Left = 0
Top = 0
Width = 631
Height = 464
Align = alClient
Columns = <
item
end>
TabOrder = 0
OnDblClick = ListView1DblClick
end
object Panel1: TPanel
Left = 631
Top = 0
Width = 151
Height = 464
Align = alRight
TabOrder = 1
object FileName: TcxButton
Left = 30
Top = 60
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #28155#21152
TabOrder = 0
OnClick = FileNameClick
LookAndFeel.Kind = lfOffice11
end
object cxButton1: TcxButton
Left = 30
Top = 96
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #21024#38500
TabOrder = 1
OnClick = cxButton1Click
LookAndFeel.Kind = lfOffice11
end
object cxButton2: TcxButton
Left = 30
Top = 132
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #21478#23384#20026'...'
TabOrder = 2
OnClick = cxButton2Click
LookAndFeel.Kind = lfOffice11
end
object cxButton3: TcxButton
Left = 30
Top = 172
Width = 75
Height = 25
Hint = 'Filesother'
Caption = #20851#38381
TabOrder = 3
Visible = False
OnClick = cxButton3Click
LookAndFeel.Kind = lfOffice11
end
end
object Panel2: TPanel
Left = 176
Top = 140
Width = 193
Height = 41
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = 'Panel2'
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
Visible = False
OnDblClick = Panel2DblClick
end
object ADOQueryTmp: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 520
Top = 28
end
object ADOQueryCmd: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 568
Top = 32
end
object ImageList1: TImageList
Left = 536
Top = 228
end
object IdFTP1: TIdFTP
MaxLineAction = maException
ReadTimeout = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
Left = 500
Top = 198
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 532
Top = 240
end
end

445
Z99Dependency/ThreeFun/Form/U_FjList10.pas Normal file
View File

@ -0,0 +1,445 @@
unit U_FjList10;
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, strutils;
type
TfrmFjList10 = class(TForm)
ListView1: TListView;
Panel1: TPanel;
FileName: TcxButton;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
ImageList1: TImageList;
Panel2: TPanel;
IdFTP1: TIdFTP;
ADOConnection1: TADOConnection;
procedure cxButton3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FileNameClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel2DblClick(Sender: TObject);
private
procedure InitData();
{ Private declarations }
public
fkeyNO: string;
fType: string;
fId: integer;
fstatus: integer;
{ Public declarations }
end;
var
frmFjList10: TfrmFjList10;
implementation
uses
U_DataLink, U_Fun10, U_CompressionFun;
{$R *.dfm}
procedure TfrmFjList10.InitData();
var
ListItem: TListItem;
Flag: Cardinal;
info: SHFILEINFOA;
Icon: TIcon;
begin
ListView1.Items.Clear;
try
with adoqueryTmp do
begin
close;
sql.Clear;
sql.Add('select * from TP_File ');
sql.Add('where WBID=' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)));
open;
if not IsEmpty then
begin
while not eof do
begin
with ListView1 do
begin
LargeImages := ImageList1;
Icon := TIcon.Create;
ListItem := Items.Add;
ListItem.Caption := trim(fieldbyname('fileName').AsString);
// Listitem.SubItems.Add(OpenDiaLog.FileName);
Flag := (SHGFI_SMALLICON or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
SHGetFileInfo(Pchar(trim(fieldbyname('fileName').AsString)), 0, info, Sizeof(info), Flag);
Icon.Handle := info.hIcon;
ImageList1.AddIcon(Icon);
ListItem.ImageIndex := ImageList1.Count - 1;
end;
next;
end;
end;
end;
except
end;
end;
procedure TfrmFjList10.cxButton3Click(Sender: TObject);
begin
ADOQueryTmp.Close;
ADOQuerycmd.Close;
ListView1.Items.Free;
ModalResult := -1;
end;
procedure TfrmFjList10.FormDestroy(Sender: TObject);
begin
frmFjList10 := nil;
end;
procedure TfrmFjList10.FileNameClick(Sender: TObject);
var
OpenDiaLog: TOpenDialog;
fFileName: string;
fFilePath: string;
maxNo: string;
// myStream: TADOBlobStream;
// FJStream : TMemoryStream;
FJStream: TMemoryStream;
mfileSize: integer;
mCreationTime: TdateTime;
mWriteTime: TdateTime;
begin
try
OpenDiaLog := TOpenDialog.Create(Self);
if OpenDiaLog.Execute then
begin
fFilePath := OpenDiaLog.FileName;
fFileName := ExtractFileName(OpenDiaLog.FileName);
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select TFId from TP_File ');
sql.Add('where WBID<>' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)));
sql.Add('and FileName=' + quotedstr(trim(fFileName)));
open;
if not adoqueryCmd.IsEmpty then
begin
application.MessageBox('此附件名称已存在，请修改文件名，继续上传！', '提示信息', MB_ICONERROR);
exit;
end;
end;
Panel2.Caption := '正在上传数据，请稍等...';
Panel2.Visible := true;
application.ProcessMessages;
if GetLSNo(ADOQueryCmd, maxNo, 'FJ', 'TP_File', 4, 1) = False then
begin
Application.MessageBox('取最大号失败！', '提示', 0);
Exit;
end;
//获取文件信息
GetFileInfo(fFilePath, mfileSize, mCreationTime, mWriteTime);
adoqueryCmd.Connection.BeginTrans;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where WBID=' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)));
sql.Add('and FileName=' + quotedstr(trim(fFileName)));
execsql;
end;
try
FJStream := TMemoryStream.Create;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from TP_File ');
sql.Add('where WBID=' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)));
sql.Add('and FileName=' + quotedstr(trim(fFileName)));
open;
append;
fieldbyname('TFID').Value := trim(maxNo);
fieldbyname('WBID').Value := trim(fkeyNO);
fieldbyname('TFType').Value := trim(fType);
fieldbyname('FileName').Value := trim(fFileName);
FJStream.LoadFromFile(fFilePath);
CompressionStream(FJStream);
tblobfield(FieldByName('Filesother')).LoadFromStream(FJStream);
// tblobfield(FieldByName('Filesother')).LoadFromFile(fFilePath);
post;
end;
{ if fFilePath <> '' then
begin
try
IdFTP1.Host := PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
IdFTP1.Put(fFilePath, 'FJ\' + Trim(fFileName));
IdFTP1.Quit;
except
IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败，请检查文件服务器！', '提示', MB_ICONWARNING);
end;
end;
IdFTP1.Quit; }
Panel2.Visible := false;
initdata();
finally
// FJStream.Free;
end;
adoqueryCmd.Connection.CommitTrans;
end;
except
adoqueryCmd.Connection.RollbackTrans;
application.MessageBox('附件保存失败！', '提示信息', 0);
end;
end;
procedure TfrmFjList10.FormCreate(Sender: TObject);
begin
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
//ConnectionString:='';
Connected := true;
end;
ListView1.Align := alclient;
fstatus := 0;
end;
procedure TfrmFjList10.FormShow(Sender: TObject);
begin
if fstatus = 0 then
Panel1.Visible := true
else
Panel1.Visible := false;
initdata();
end;
procedure TfrmFjList10.ListView1DblClick(Sender: TObject);
var
sFieldName: string;
fileName: string;
ff: TADOBlobStream;
FJStream: TMemoryStream;
begin
if ListView1.Items.Count < 1 then
EXIT;
if listView1.SelCount < 1 then
exit;
sFieldName := leftbstr(ExtractFilePath(Application.ExeName), 1) + ':\图片查看';
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,true, false);
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);
}
try
adoqueryTmp.Locate('FileName', fileName, []);
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;
procedure TfrmFjList10.cxButton1Click(Sender: TObject);
var
fFileName: string;
fFilePath: string;
begin
if listView1.SelCount < 1 then
exit;
try
fFileName := ListView1.Selected.Caption;
// ADOQueryTmp.Locate('fileName',fFileName,[]);
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from TP_File ');
sql.Add('where WBID=' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)));
sql.Add('and FileName=' + quotedstr(trim(fFileName)));
execsql;
end;
initData();
except
end;
end;
procedure TfrmFjList10.cxButton2Click(Sender: TObject);
var
SaveDialog: TSaveDialog;
fFileName: string;
fFilePath: string;
ff: TADOBlobStream;
FJStream: TMemoryStream;
begin
if listView1.SelCount < 1 then
exit;
try
fFileName := ListView1.Selected.Caption;
adoqueryTmp.Locate('FileName', fFileName, []);
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;
Panel2.Visible := false;
end;
end;
{ 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(fFileName), fFilePath,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;
end; }
except
Panel2.Visible := false;
end;
end;
procedure TfrmFjList10.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if fId = 10 then
Action := cafree
else
Action := cahide;
end;
procedure TfrmFjList10.Panel2DblClick(Sender: TObject);
begin
Panel2.Visible := false;
end;
end.

46
Z99Dependency/ThreeFun/Form/U_GetAddRess.dfm Normal file
View File

@ -0,0 +1,46 @@
object Form1: TForm1
Left = 387
Top = 243
Width = 520
Height = 376
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 128
Top = 96
Width = 32
Height = 13
Caption = 'Label1'
end
object Label2: TLabel
Left = 208
Top = 104
Width = 32
Height = 13
Caption = 'Label2'
end
object Button1: TButton
Left = 112
Top = 48
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Edit1: TEdit
Left = 200
Top = 48
Width = 121
Height = 21
TabOrder = 1
end
end

43
Z99Dependency/ThreeFun/Form/U_GetAddRess.pas Normal file
View File

@ -0,0 +1,43 @@
unit U_GetAddRess;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,StdCtrls,WinSock, ComCtrls;
Function sendarp(ipaddr:ulong;temp:dword;ulmacaddr:pointer;ulmacaddrleng:pointer) : DWord; StdCall; External 'Iphlpapi.dll' Name 'SendARP';
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
myip:ulong;
mymac:array[0..5] of byte;
mymaclength:ulong;
r:integer;
begin
{myip:=inet_addr(PChar(Trim(Edit1.Text)));
mymaclength:=length(mymac);
r:=sendarp(myip,0,@mymac,@mymaclength);
label1.caption:='errorcode:'+inttostr(r);
label2.caption:=format('%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x',[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]); }
end;
end.

3635
Z99Dependency/ThreeFun/Form/U_ItemManageNew.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

264
Z99Dependency/ThreeFun/Form/U_ItemManageNew.pas Normal file
View File

@ -0,0 +1,264 @@
unit U_ItemManageNew;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls;
type
TfrmItemManageNew = class(TForm)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
V1Code: TcxGridDBColumn;
V1Name: TcxGridDBColumn;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
TBAdd: TToolButton;
TBSave: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
TBEdit: TToolButton;
V1Note: TcxGridDBColumn;
V1OrderNo: TcxGridDBColumn;
ADOConnection1: TADOConnection;
ImageList24: TImageList;
Panel1: TPanel;
Label1: TLabel;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBAddClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
private
procedure InitGrid();
{ Private declarations }
public
flag,flagname,snote:string;
fnote,forderno:Boolean;
{ Public declarations }
end;
var
frmItemManageNew: TfrmItemManageNew;
implementation
uses
U_DataLink,U_Fun;
{$R *.dfm}
procedure TfrmItemManageNew.FormCreate(Sender: TObject);
begin
cxGrid1.Align:=alClient;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
Connected:=true;
end;
end;
procedure TfrmItemManageNew.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmItemManageNew.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select * from XC_Code where Flag='''+flag+'''');
Open;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmItemManageNew.TBAddClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
with ClientDataSet1 do
begin
Append;
Post;
end;
end;
procedure TfrmItemManageNew.TBSaveClick(Sender: TObject);
begin
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete XC_Code where Flag='''+Flag+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from XC_Code where 1<>1');
Open;
end;
with ADOQueryCmd do
begin
if ClientDataSet1.IsEmpty then
begin
ADOQueryCmd.Close;
ADOQueryCmd.sql.Clear;
ADOQueryCmd.sql.Add('delete from XC_Code where Code='''+Flag+'''');
ADOQueryCmd.ExecSQL;
end else
begin
with ClientDataSet1 do
begin
First;
while not eof do
begin
if Trim(ClientDataSet1.FieldByName('Code').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('编号不能为空！','提示',0);
Exit;
end;
if Trim(ClientDataSet1.FieldByName('Name').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('名称不能为空！','提示',0);
Exit;
end;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from XC_Code where Code='''+Trim(ClientDataSet1.fieldbyname('Code').AsString)+'''');
Open;
if not IsEmpty then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('编号重复！','提示',0);
Exit;
end;
end;
ADOQueryCmd.Append;
ADOQueryCmd.FieldByName('Code').Value:=ClientDataSet1.fieldbyname('Code').AsString;
ADOQueryCmd.FieldByName('Name').Value:=ClientDataSet1.fieldbyname('Name').AsString;
ADOQueryCmd.FieldByName('note').Value:=Trim(snote);
//ADOQueryCmd.FieldByName('orderno').Value:=ClientDataSet1.fieldbyname('Name').AsString;
ADOQueryCmd.FieldByName('Flag').Value:=flag;
ADOQueryCmd.FieldByName('valid').Value:='Y';
ADOQueryCmd.FieldByName('sel').Value:=0;
ADOQueryCmd.Post;
Next;
end;
end;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功！','提示',0);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败！','提示',0);
end;
TV1.OptionsData.Editing:=False;
end;
procedure TfrmItemManageNew.TBDelClick(Sender: TObject);
begin
if ClientDataSet1.IsEmpty then Exit;
if (Trim(ClientDataSet1.FieldByName('Code').AsString)<>'') or
(Trim(ClientDataSet1.FieldByName('name').AsString)<>'') then
begin
if application.MessageBox('确定要删除吗?','提示信息',1)=2 then exit;
ClientDataSet1.Delete;
end;
end;
procedure TfrmItemManageNew.TBCloseClick(Sender: TObject);
begin
ModalResult:=2;
Close;
end;
procedure TfrmItemManageNew.FormShow(Sender: TObject);
var
fsj,fsj1:string;
begin
InitGrid();
fsj:=Trim(flag)+'01';
fsj1:=Trim(flagname)+'01';
if ClientDataSet1.IsEmpty then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
//sql.Add('insert into XC_Code(code,name,flag,note)');
//sql.Add('select '''+Trim(flag)+'''');
//sql.Add(','''+Trim(flagname)+'''');
//SQL.Add(',''BASECODE'' ');
//sql.Add(','''+Trim(snote)+'''');
sql.Add('insert into XC_Code(code,name,flag,note)');
sql.Add('select '''+Trim(fsj)+'''');
sql.Add(','''+Trim(fsj1)+'''');
SQL.Add(','''+Trim(flag)+'''');
sql.Add(','''+Trim(snote)+'''');
ExecSQL;
end;
InitGrid();
end;
frmItemManageNew.Caption:=Trim(flagname)+'<'+Trim(flag)+'>';
end;
procedure TfrmItemManageNew.ToolButton1Click(Sender: TObject);
begin
ModalResult:=1;
end;
procedure TfrmItemManageNew.TBEditClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
end;
procedure TfrmItemManageNew.TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if TV1.OptionsData.Editing=False then
begin
ModalResult:=1;
end;
end;
end.

17996
Z99Dependency/ThreeFun/Form/U_KHHelp.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

167
Z99Dependency/ThreeFun/Form/U_KHHelp.pas Normal file
View File

@ -0,0 +1,167 @@
unit U_KHHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu;
type
TfrmKHHelp = class(TForm)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
V1Name: TcxGridDBColumn;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
ZDYName: TEdit;
ThreeImgList: TImageList;
cxGridPopupMenu1: TcxGridPopupMenu;
V1Column1: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure ZDYNameChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
flag,flagname,snote,MainType:string;
fnote,forderno,fZdyFlag:Boolean;
PPSTE:integer;
{ Public declarations }
end;
var
frmKHHelp: TfrmKHHelp;
implementation
uses
U_DataLink,U_Fun;
{$R *.dfm}
procedure TfrmKHHelp.FormCreate(Sender: TObject);
begin
try
cxGrid1.Align:=alClient;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='';
Connected:=true;
end;
except
frmKHHelp.Free;
end;
end;
procedure TfrmKHHelp.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
ZDYName.SetFocus;
Action:=caFree;
end;
procedure TfrmKHHelp.InitGrid();
var
CYType:String;
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add('select * from SY_User where UserId='''+Trim(DCode)+'''');
Open;
end;
CYType:=Trim(ADOQueryTemp.fieldbyname('DPID').AsString);
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('exec P_Select_User_KHName :CYType');
Parameters.ParamByName('CYType').Value:=Trim(CYType);
Open;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmKHHelp.TBCloseClick(Sender: TObject);
begin
ModalResult:=2;
ZDYName.SetFocus;
WriteCxGrid('客户名称',TV1,'基础数据');
Close;
end;
procedure TfrmKHHelp.FormShow(Sender: TObject);
begin
InitGrid();
ReadCxGrid('客户名称',TV1,'基础数据');
end;
procedure TfrmKHHelp.ToolButton1Click(Sender: TObject);
begin
ZDYName.SetFocus;
ModalResult:=1;
end;
procedure TfrmKHHelp.TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if TV1.OptionsData.Editing=False then
begin
ModalResult:=1;
end;
end;
procedure TfrmKHHelp.ZDYNameChange(Sender: TObject);
var
fsj:String;
begin
if Trim(ZDYName.Text)<>'' then
begin
fsj:=' zdyname like '''+'%'+Trim(ZDYName.Text)+'%'+''''
+' or ZJM like '''+'%'+Trim(ZDYName.Text)+'%'+'''';
end;
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,fsj);
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
end;
end;
procedure TfrmKHHelp.FormDestroy(Sender: TObject);
begin
frmKHHelp:=nil;
end;
end.

104
Z99Dependency/ThreeFun/Form/U_SelExportField.dfm Normal file
View File

@ -0,0 +1,104 @@
object frmSelExportField: TfrmSelExportField
Left = 473
Top = 162
BorderStyle = bsDialog
Caption = #23383#27573#23548#20986#36873#25321
ClientHeight = 493
ClientWidth = 430
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Button1: TButton
Left = 94
Top = 456
Width = 75
Height = 25
Caption = #30830#23450
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 243
Top = 456
Width = 75
Height = 25
Caption = #20851#38381
TabOrder = 1
OnClick = Button2Click
end
object cxGrid1: TcxGrid
Left = 425
Top = 63
Width = 281
Height = 113
TabOrder = 2
Visible = False
object ExpGrid: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
DataController.DataSource = ExportDataSource
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.AlwaysShowEditor = True
OptionsView.GroupByBox = False
end
object cxGrid1Level1: TcxGridLevel
GridView = ExpGrid
end
end
object Panel2: TScrollBox
Left = 2
Top = 0
Width = 423
Height = 438
HorzScrollBar.Visible = False
Color = clSkyBlue
ParentColor = False
TabOrder = 3
object Label4: TLabel
Left = 158
Top = 9
Width = 60
Height = 14
Caption = #23383#27573#36873#25321
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
end
object CheckBox1: TCheckBox
Left = 20
Top = 449
Width = 49
Height = 17
Caption = #20840#36873
TabOrder = 4
OnClick = CheckBox1Click
end
object CheckBox2: TCheckBox
Left = 20
Top = 465
Width = 49
Height = 17
Caption = #20840#24323
TabOrder = 5
OnClick = CheckBox2Click
end
object ExportDataSource: TDataSource
Left = 424
Top = 233
end
end

310
Z99Dependency/ThreeFun/Form/U_SelExportField.pas Normal file
View File

@ -0,0 +1,310 @@
unit U_SelExportField;
interface
uses
{Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids, DBGrids, RM_FormReport, RM_PDBGrid,
DB,IniFiles, RM_Common, RM_Class, RM_e_Xls, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData,
cxGridLevel, cxClasses, cxControls, cxGridCustomView,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid; }
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit,DBGrids, DB, cxDBData,
cxGridLevel, cxClasses, cxControls, cxGridCustomView, ADODB,StrUtils,
Midas,cxGridCustomTableView, cxGridTableView, cxGridDBTableView,cxTimeEdit,
cxTreeView, cxGrid,cxDBLookupComboBox,cxCalendar, cxCurrencyEdit,cxGridExportLink,
ExtCtrls, Buttons,DBClient,FTComboBox,cxDropDownEdit,cxGridBandedTableView,
cxGridDBBandedTableView,cxRichEdit,cxButtonEdit,IniFiles,WinSock,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator;
type
TfrmSelExportField = class(TForm)
Button1: TButton;
Button2: TButton;
ExportDataSource: TDataSource;
ExpGrid: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
Panel2: TScrollBox;
Label4: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
private
procedure CreateCheckBox();
procedure ExportData();
procedure ReadINIFile(fieldname:string);
procedure WriteINIFile(fieldname:string);
Function IsINIFile(fieldname:string):Boolean;
procedure GetExportFields();
procedure IsCheck();
procedure TcxGridToExcel(mfileName:string;gridName:TcxGrid);
{ Private declarations }
public
ExportFields,IniName:string;
{ Public declarations }
end;
var
frmSelExportField: TfrmSelExportField;
implementation
//uses U_SelPrintField,U_FormPas;
{$R *.dfm}
procedure TfrmSelExportField.CreateCheckBox();
var
i,j,FTop,FLeft,Fdiv,FMod:Integer;// mod 余数，div商
FCheckBox:TCheckBox;
begin
for i:=0 to ExpGrid.ColumnCount-1 do
begin
Fdiv:=(i+1) div 3;
FMod:=(i+1) mod 3;
FCheckBox:=TCheckBox.Create(Self);
FCheckBox.Caption:=Trim(ExpGrid.Columns[i].Caption);
FCheckBox.TabOrder:=i;
FCheckBox.Parent:=Panel2;
FCheckBox.Checked:=True;
if FMod>0 then
FCheckBox.Top:=36*(Fdiv+1)
else
FCheckBox.Top:=36*Fdiv;
if FMod=1 then
FCheckBox.Left:=29
else if FMod=2 then
FCheckBox.Left:=163
else if FMod=0 then
FCheckBox.Left:=305;
end;
end;
procedure TfrmSelExportField.TcxGridToExcel(mfileName:string;gridName:TcxGrid);
var
saveDialog:TSaveDialog;
begin
try
saveDialog:=TSaveDialog.Create(nil);
saveDialog.Filter:='xls(*.xls)|*.xls|全部(*.*)|*.*';
saveDialog.Options:=[ofOverwritePrompt];
saveDialog.FileName:=mfileName;
if saveDialog.Execute then
if Assigned(gridName) then
begin
try
ExportGridToExcel(saveDialog.FileName,gridName);
except
application.MessageBox('创建失败,源文件可能处于编辑状态!','提示信息',0);
exit;
end;
application.MessageBox('成功导出!','提示信息',0);
end
else
application.MessageBox('导出失败!','提示信息',0);
finally
saveDialog.Free;
end;
end;
procedure TfrmSelExportField.Button1Click(Sender: TObject);
begin
//ShowMessage('10除以3取余'+inttostr(10 mod 3)+',取整'+inttostr(10 div 3));
ExportData();
GetExportFields();
if IsINIFile(IniName)=True then
begin
DeleteFile(IniName);
end;
WriteINIFile(IniName);
end;
procedure TfrmSelExportField.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmSelExportField.FormDestroy(Sender: TObject);
begin
frmSelExportField:=nil;
end;
procedure TfrmSelExportField.FormShow(Sender: TObject);
begin
CreateCheckBox();
ReadINIFile(IniName);
IsCheck();
end;
procedure TfrmSelExportField.IsCheck();
var
i:Integer;
fsj:string;
begin
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
fsj:=Trim(TCheckBox(Controls[i]).Caption);
if Pos(fsj,ExportFields)>0 then
TCheckBox(Controls[i]).Checked:=True
else
TCheckBox(Controls[i]).Checked:=False;
end;
end;
end;
end;
procedure TfrmSelExportField.ExportData();
var
i,j:Integer;
begin
j:=0;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked=True then
begin
j:=1;
ExpGrid.Columns[TCheckBox(Controls[i]).TabOrder].Visible:=True
end else
begin
ExpGrid.Columns[TCheckBox(Controls[i]).TabOrder].Visible:=False;
end;
end;
end;
end;
TcxGridToExcel(Trim(IniName),cxGrid1);
end;
procedure TfrmSelExportField.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TfrmSelExportField.ReadINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldExportSet\' +trim(fieldname)+'.INI';
programIni:=Tinifile.create(FName);
ExportFields:=programIni.ReadString('导出设置','导出字段','');
programIni.Free;
end;
procedure TfrmSelExportField.GetExportFields();
var
i:Integer;
begin
ExportFields:='Begin';
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked then
begin
ExportFields:=ExportFields+'/'+TCheckBox(Controls[i]).Caption;
end;
end;
end;
end;
end;
//////////////////////////////////////////////////////////////////
//写设置信息到INI文件
//参数
//////////////////////////////////////////////////////////////////
procedure TfrmSelExportField.WriteINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldExportSet\'+trim(fieldname)+'.INI';
if not DirectoryExists(ExtractFileDir(FName)) then
CreateDir(ExtractFileDir(FName));
programIni:=Tinifile.create(FName);
programIni.WriteString('导出设置','导出字段',ExportFields);
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//判断InI文件是否存在
//////////////////////////////////////////////////////////////////
Function TfrmSelExportField.IsINIFile(fieldname:string):Boolean;
var
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldExportSet\'+trim(fieldname)+'.INI';
if FileExists(FName) then
Result:=True
else
Result:=false;
end;
procedure TfrmSelExportField.CheckBox1Click(Sender: TObject);
var
i:Integer;
begin
if CheckBox1.Checked then
begin
CheckBox2.Checked:=False;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if (TCheckBox(Controls[i]).Name<>'CheckBox1') and (TCheckBox(Controls[i]).Name<>'CheckBox2') then
begin
TCheckBox(Controls[i]).Checked:=True;
end;
end;
end;
end;
end;
end;
procedure TfrmSelExportField.CheckBox2Click(Sender: TObject);
var
i:Integer;
begin
if CheckBox2.Checked then
begin
CheckBox1.Checked:=False;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if (TCheckBox(Controls[i]).Name<>'CheckBox1') and (TCheckBox(Controls[i]).Name<>'CheckBox2') then
begin
TCheckBox(Controls[i]).Checked:=False;
end;
end;
end;
end;
end;
end;
end.

149
Z99Dependency/ThreeFun/Form/U_SelPrintField.dfm Normal file
View File

@ -0,0 +1,149 @@
object frmSelPrintField: TfrmSelPrintField
Left = 329
Top = 100
Width = 427
Height = 530
Caption = #23383#27573#25171#21360#36873#25321
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Button1: TButton
Left = 94
Top = 456
Width = 75
Height = 25
Caption = #30830#23450
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 243
Top = 456
Width = 75
Height = 25
Caption = #20851#38381
TabOrder = 1
OnClick = Button2Click
end
object PrnGrid: TDBGrid
Left = 497
Top = 93
Width = 200
Height = 120
DataSource = PrintDataSource
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 2
TitleFont.Charset = ANSI_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -16
TitleFont.Name = #23435#20307
TitleFont.Style = []
Visible = False
end
object ScrollBox1: TScrollBox
Left = 2
Top = 0
Width = 415
Height = 438
Color = clSkyBlue
ParentColor = False
TabOrder = 3
object Label4: TLabel
Left = 158
Top = 9
Width = 60
Height = 14
Caption = #23383#27573#36873#25321
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
end
object RMPrintDBGrid1: TRMPrintDBGrid
ReportOptions = [rmgoStretch, rmgoWordWrap, rmgoGridLines]
PageLayout.LeftMargin = 38
PageLayout.TopMargin = 38
PageLayout.RightMargin = 38
PageLayout.BottomMargin = 38
PageLayout.Height = 2970
PageLayout.Width = 2100
PageLayout.PageBin = 0
PageLayout.PrinterName = #40664#35748#25171#21360#26426
PageLayout.ColorPrint = False
PageHeaderMsg.Font.Charset = GB2312_CHARSET
PageHeaderMsg.Font.Color = clWindowText
PageHeaderMsg.Font.Height = -13
PageHeaderMsg.Font.Name = #23435#20307
PageHeaderMsg.Font.Style = []
PageFooterMsg.Font.Charset = GB2312_CHARSET
PageFooterMsg.Font.Color = clWindowText
PageFooterMsg.Font.Height = -15
PageFooterMsg.Font.Name = #23435#20307
PageFooterMsg.Font.Style = []
PageCaptionMsg.CaptionMsg.Font.Charset = GB2312_CHARSET
PageCaptionMsg.CaptionMsg.Font.Color = clWindowText
PageCaptionMsg.CaptionMsg.Font.Height = -13
PageCaptionMsg.CaptionMsg.Font.Name = #23435#20307
PageCaptionMsg.CaptionMsg.Font.Style = []
PageCaptionMsg.TitleFont.Charset = GB2312_CHARSET
PageCaptionMsg.TitleFont.Color = clWindowText
PageCaptionMsg.TitleFont.Height = -16
PageCaptionMsg.TitleFont.Name = #23435#20307
PageCaptionMsg.TitleFont.Style = [fsBold]
MasterDataBandOptions.ReprintColumnHeaderOnNewColumn = True
GridNumOptions.Text = 'No'
GridFontOptions.Font.Charset = ANSI_CHARSET
GridFontOptions.Font.Color = clWindowText
GridFontOptions.Font.Height = -15
GridFontOptions.Font.Name = #23435#20307
GridFontOptions.Font.Style = []
ReportSettings.InitialZoom = pzDefault
ReportSettings.PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbSaveToXLS]
DBGrid = PrnGrid
Left = 339
Top = 449
end
object PrintDataSource: TDataSource
DataSet = ClientDataSet1
Left = 536
Top = 246
end
object RMXLSExport1: TRMXLSExport
ShowAfterExport = True
ExportPrecision = 1
PagesOfSheet = 1
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 359
Top = 368
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 378
Top = 340
end
end

241
Z99Dependency/ThreeFun/Form/U_SelPrintField.pas Normal file
View File

@ -0,0 +1,241 @@
unit U_SelPrintField;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids, DBGrids, RM_FormReport, RM_PDBGrid,
DB,IniFiles, RM_Common, RM_Class, RM_e_Xls, DBClient;
type
TfrmSelPrintField = class(TForm)
RMPrintDBGrid1: TRMPrintDBGrid;
Button1: TButton;
Button2: TButton;
PrintDataSource: TDataSource;
PrnGrid: TDBGrid;
RMXLSExport1: TRMXLSExport;
ClientDataSet1: TClientDataSet;
ScrollBox1: TScrollBox;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure CreateCheckBox();
procedure PrintData();
procedure ReadINIFile(fieldname:string);
procedure WriteINIFile(fieldname:string);
Function IsINIFile(fieldname:string):Boolean;
procedure GetPrintFields();
procedure IsCheck();
{ Private declarations }
public
PrintFields,IniName:string;
{ Public declarations }
end;
var
frmSelPrintField: TfrmSelPrintField;
implementation
{$R *.dfm}
procedure TfrmSelPrintField.CreateCheckBox();
var
i,j,FTop,FLeft,Fdiv,FMod:Integer;// mod 余数，div商
FCheckBox:TCheckBox;
begin
for i:=0 to PrnGrid.Columns.Count-1 do
begin
Fdiv:=(i+1) div 3;
FMod:=(i+1) mod 3;
FCheckBox:=TCheckBox.Create(Self);
FCheckBox.Caption:=Trim(PrnGrid.Columns[i].Title.Caption);
FCheckBox.TabOrder:=i;
FCheckBox.Parent:=ScrollBox1;
FCheckBox.Checked:=True;
if FMod>0 then
FCheckBox.Top:=36*(Fdiv+1)
else
FCheckBox.Top:=36*Fdiv;
if FMod=1 then
FCheckBox.Left:=29
else if FMod=2 then
FCheckBox.Left:=163
else if FMod=0 then
FCheckBox.Left:=305;
end;
end;
procedure TfrmSelPrintField.Button1Click(Sender: TObject);
begin
//ShowMessage('10除以3取余'+inttostr(10 mod 3)+',取整'+inttostr(10 div 3));
PrintData();
GetPrintFields();
if IsINIFile(IniName)=True then
begin
DeleteFile(IniName);
end;
WriteINIFile(IniName);
end;
procedure TfrmSelPrintField.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmSelPrintField.FormDestroy(Sender: TObject);
begin
frmSelPrintField:=nil;
end;
procedure TfrmSelPrintField.FormShow(Sender: TObject);
begin
CreateCheckBox();
ReadINIFile(IniName);
IsCheck();
end;
procedure TfrmSelPrintField.IsCheck();
var
i:Integer;
fsj:string;
begin
with ScrollBox1 do
begin
for i:=0 to ScrollBox1.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
fsj:=Trim(TCheckBox(Controls[i]).Caption);
if Pos(fsj,PrintFields)>0 then
TCheckBox(Controls[i]).Checked:=True
else
TCheckBox(Controls[i]).Checked:=False;
end;
end;
end;
end;
procedure TfrmSelPrintField.PrintData();
var
i,j,k:Integer;
FFieldName:string;
begin
j:=0;
k:=0;
with ScrollBox1 do
begin
for i:=0 to ScrollBox1.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked=True then
begin
j:=1;
PrnGrid.Columns[TCheckBox(Controls[i]).TabOrder].Visible:=True;
k:=k+1;
if k=1 then
begin
FFieldName:=PrnGrid.Columns[TCheckBox(Controls[i]).TabOrder].FieldName;
end;
end else
begin
PrnGrid.Columns[TCheckBox(Controls[i]).TabOrder].Visible:=False;
end;
end;
end;
end;
{ClientDataSet1.Last;
if Trim(ClientDataSet1.FieldByName('flag').AsString)='Y' then
begin
ClientDataSet1.Edit;
ClientDataSet1.FieldByName(FFieldName).Value:='合计';
ClientDataSet1.Post;
end;}
if j=1 then
begin
RMPrintDBGrid1.ShowReport ;
end
else
begin
Application.MessageBox('没有可打印的信息！','提示',0);
Exit;
end;
//Panel2.Visible:=False;
//RMPrintDBGrid1.ShowReport;
end;
procedure TfrmSelPrintField.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TfrmSelPrintField.ReadINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldPrintSet\' +trim(fieldname)+'.INI';
programIni:=Tinifile.create(FName);
PrintFields:=programIni.ReadString('打印设置','打印字段','');
programIni.Free;
end;
procedure TfrmSelPrintField.GetPrintFields();
var
i:Integer;
begin
PrintFields:='Begin';
with ScrollBox1 do
begin
for i:=0 to ScrollBox1.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked then
begin
PrintFields:=PrintFields+'/'+TCheckBox(Controls[i]).Caption;
end;
end;
end;
end;
end;
//////////////////////////////////////////////////////////////////
//写设置信息到INI文件
//参数
//////////////////////////////////////////////////////////////////
procedure TfrmSelPrintField.WriteINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldPrintSet\'+trim(fieldname)+'.INI';
if not DirectoryExists(ExtractFileDir(FName)) then
CreateDir(ExtractFileDir(FName));
programIni:=Tinifile.create(FName);
programIni.WriteString('打印设置','打印字段',PrintFields);
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//判断InI文件是否存在
//////////////////////////////////////////////////////////////////
Function TfrmSelPrintField.IsINIFile(fieldname:string):Boolean;
var
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldPrintSet\'+trim(fieldname)+'.INI';
if FileExists(FName) then
Result:=True
else
Result:=false;
end;
end.

178
Z99Dependency/ThreeFun/Form/U_SelPrintFieldNew.dfm Normal file
View File

@ -0,0 +1,178 @@
object frmSelPrintFieldNew: TfrmSelPrintFieldNew
Left = 219
Top = 32
BorderStyle = bsDialog
Caption = #23383#27573#25171#21360#36873#25321
ClientHeight = 493
ClientWidth = 428
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Button1: TButton
Left = 94
Top = 456
Width = 75
Height = 21
Caption = #30830#23450
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 243
Top = 456
Width = 75
Height = 21
Caption = #20851#38381
TabOrder = 1
OnClick = Button2Click
end
object PrnGrid: TDBGrid
Left = 17
Top = 165
Width = 320
Height = 120
DataSource = PrintDataSource
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 2
TitleFont.Charset = GB2312_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -12
TitleFont.Name = #23435#20307
TitleFont.Style = []
Visible = False
end
object Panel2: TScrollBox
Left = 2
Top = 0
Width = 423
Height = 438
HorzScrollBar.Visible = False
BevelInner = bvSpace
BevelKind = bkTile
BorderStyle = bsNone
Color = clSkyBlue
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentColor = False
ParentFont = False
TabOrder = 3
object Label4: TLabel
Left = 166
Top = 9
Width = 60
Height = 14
Caption = #23383#27573#36873#25321
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
end
object CheckBox1: TCheckBox
Left = 21
Top = 450
Width = 49
Height = 17
Caption = #20840#36873
TabOrder = 4
OnClick = CheckBox1Click
end
object CheckBox2: TCheckBox
Left = 21
Top = 466
Width = 49
Height = 17
Caption = #20840#24323
TabOrder = 5
OnClick = CheckBox2Click
end
object RMPrintDBGrid1: TRMPrintDBGrid
ReportOptions = [rmgoStretch, rmgoWordWrap, rmgoGridLines]
PageLayout.LeftMargin = 38
PageLayout.TopMargin = 38
PageLayout.RightMargin = 38
PageLayout.BottomMargin = 38
PageLayout.Height = 2970
PageLayout.Width = 2100
PageLayout.PageBin = 0
PageLayout.PrinterName = #40664#35748#25171#21360#26426
PageLayout.ColorPrint = False
PageHeaderMsg.Font.Charset = GB2312_CHARSET
PageHeaderMsg.Font.Color = clWindowText
PageHeaderMsg.Font.Height = -13
PageHeaderMsg.Font.Name = #23435#20307
PageHeaderMsg.Font.Style = []
PageFooterMsg.Font.Charset = GB2312_CHARSET
PageFooterMsg.Font.Color = clWindowText
PageFooterMsg.Font.Height = -15
PageFooterMsg.Font.Name = #23435#20307
PageFooterMsg.Font.Style = []
PageCaptionMsg.CaptionMsg.Font.Charset = GB2312_CHARSET
PageCaptionMsg.CaptionMsg.Font.Color = clWindowText
PageCaptionMsg.CaptionMsg.Font.Height = -12
PageCaptionMsg.CaptionMsg.Font.Name = #23435#20307
PageCaptionMsg.CaptionMsg.Font.Style = []
PageCaptionMsg.TitleFont.Charset = GB2312_CHARSET
PageCaptionMsg.TitleFont.Color = clWindowText
PageCaptionMsg.TitleFont.Height = -16
PageCaptionMsg.TitleFont.Name = #23435#20307
PageCaptionMsg.TitleFont.Style = [fsBold]
MasterDataBandOptions.ReprintColumnHeaderOnNewColumn = True
GridNumOptions.Text = 'No'
GridFontOptions.Font.Charset = ANSI_CHARSET
GridFontOptions.Font.Color = clWindowText
GridFontOptions.Font.Height = -15
GridFontOptions.Font.Name = #23435#20307
GridFontOptions.Font.Style = []
ReportSettings.InitialZoom = pzDefault
ReportSettings.PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbSaveToXLS]
DBGrid = PrnGrid
Left = 339
Top = 449
end
object PrintDataSource: TDataSource
DataSet = ClientDataSet1
Left = 536
Top = 246
end
object RMXLSExport1: TRMXLSExport
ShowAfterExport = True
ExportPrecision = 1
PagesOfSheet = 1
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 359
Top = 368
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 378
Top = 340
end
end

292
Z99Dependency/ThreeFun/Form/U_SelPrintFieldNew.pas Normal file
View File

@ -0,0 +1,292 @@
unit U_SelPrintFieldNew;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids, DBGrids, RM_FormReport, RM_PDBGrid,
DB,IniFiles, RM_Common, RM_Class, RM_e_Xls, DBClient;
type
TfrmSelPrintFieldNew = class(TForm)
RMPrintDBGrid1: TRMPrintDBGrid;
Button1: TButton;
Button2: TButton;
PrintDataSource: TDataSource;
PrnGrid: TDBGrid;
RMXLSExport1: TRMXLSExport;
ClientDataSet1: TClientDataSet;
Panel2: TScrollBox;
Label4: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
private
procedure CreateCheckBox();
procedure PrintData();
procedure ReadINIFile(fieldname:string);
procedure WriteINIFile(fieldname:string);
Function IsINIFile(fieldname:string):Boolean;
procedure GetPrintFields();
procedure IsCheck();
{ Private declarations }
public
PrintFields,IniName:string;
{ Public declarations }
end;
var
frmSelPrintFieldNew: TfrmSelPrintFieldNew;
implementation
{$R *.dfm}
procedure TfrmSelPrintFieldNew.CreateCheckBox();
var
i,j,FTop,FLeft,Fdiv,FMod:Integer;// mod 余数，div商
FCheckBox:TCheckBox;
begin
for i:=0 to PrnGrid.Columns.Count-1 do
begin
Fdiv:=(i+1) div 3;
FMod:=(i+1) mod 3;
FCheckBox:=TCheckBox.Create(Self);
FCheckBox.Caption:=Trim(PrnGrid.Columns[i].Title.Caption);
FCheckBox.TabOrder:=i;
FCheckBox.Parent:=Panel2;
FCheckBox.Checked:=True;
if FMod>0 then
FCheckBox.Top:=36*(Fdiv+1)
else
FCheckBox.Top:=36*Fdiv;
if FMod=1 then
FCheckBox.Left:=29
else if FMod=2 then
FCheckBox.Left:=163
else if FMod=0 then
FCheckBox.Left:=305;
end;
end;
procedure TfrmSelPrintFieldNew.Button1Click(Sender: TObject);
begin
//ShowMessage('10除以3取余'+inttostr(10 mod 3)+',取整'+inttostr(10 div 3));
PrintData();
GetPrintFields();
if IsINIFile(IniName)=True then
begin
DeleteFile(IniName);
end;
WriteINIFile(IniName);
end;
procedure TfrmSelPrintFieldNew.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmSelPrintFieldNew.FormDestroy(Sender: TObject);
begin
frmSelPrintFieldNew:=nil;
end;
procedure TfrmSelPrintFieldNew.FormShow(Sender: TObject);
begin
CreateCheckBox();
ReadINIFile(IniName);
IsCheck();
end;
procedure TfrmSelPrintFieldNew.IsCheck();
var
i:Integer;
fsj:string;
begin
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
fsj:=Trim(TCheckBox(Controls[i]).Caption);
if Pos(fsj,PrintFields)>0 then
TCheckBox(Controls[i]).Checked:=True
else
TCheckBox(Controls[i]).Checked:=False;
end;
end;
end;
end;
procedure TfrmSelPrintFieldNew.PrintData();
var
i,j,k:Integer;
FFieldName:string;
begin
j:=0;
k:=0;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked=True then
begin
j:=1;
PrnGrid.Columns[TCheckBox(Controls[i]).TabOrder].Visible:=True;
k:=k+1;
if k=1 then
begin
FFieldName:=PrnGrid.Columns[TCheckBox(Controls[i]).TabOrder].FieldName;
end;
end else
begin
PrnGrid.Columns[TCheckBox(Controls[i]).TabOrder].Visible:=False;
end;
end;
end;
end;
{ClientDataSet1.Last;
if Trim(ClientDataSet1.FieldByName('flag').AsString)='Y' then
begin
ClientDataSet1.Edit;
ClientDataSet1.FieldByName(FFieldName).Value:='合计';
ClientDataSet1.Post;
end;}
if j=1 then
begin
RMPrintDBGrid1.ShowReport ;
end
else
begin
Application.MessageBox('没有可打印的信息！','提示',0);
Exit;
end;
//Panel2.Visible:=False;
//RMPrintDBGrid1.ShowReport;
end;
procedure TfrmSelPrintFieldNew.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TfrmSelPrintFieldNew.ReadINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldPrintSet\' +trim(fieldname)+'.INI';
programIni:=Tinifile.create(FName);
PrintFields:=programIni.ReadString('打印设置','打印字段','');
programIni.Free;
end;
procedure TfrmSelPrintFieldNew.GetPrintFields();
var
i:Integer;
begin
PrintFields:='Begin';
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked then
begin
PrintFields:=PrintFields+'/'+TCheckBox(Controls[i]).Caption;
end;
end;
end;
end;
end;
//////////////////////////////////////////////////////////////////
//写设置信息到INI文件
//参数
//////////////////////////////////////////////////////////////////
procedure TfrmSelPrintFieldNew.WriteINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldPrintSet\'+trim(fieldname)+'.INI';
if not DirectoryExists(ExtractFileDir(FName)) then
CreateDir(ExtractFileDir(FName));
programIni:=Tinifile.create(FName);
programIni.WriteString('打印设置','打印字段',PrintFields);
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//判断InI文件是否存在
//////////////////////////////////////////////////////////////////
Function TfrmSelPrintFieldNew.IsINIFile(fieldname:string):Boolean;
var
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldPrintSet\'+trim(fieldname)+'.INI';
if FileExists(FName) then
Result:=True
else
Result:=false;
end;
procedure TfrmSelPrintFieldNew.CheckBox1Click(Sender: TObject);
var
i:Integer;
begin
if CheckBox1.Checked then
begin
CheckBox2.Checked:=False;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if (TCheckBox(Controls[i]).Name<>'CheckBox1') and (TCheckBox(Controls[i]).Name<>'CheckBox2') then
begin
TCheckBox(Controls[i]).Checked:=True;
end;
end;
end;
end;
end;
end;
procedure TfrmSelPrintFieldNew.CheckBox2Click(Sender: TObject);
var
i:Integer;
begin
if CheckBox2.Checked then
begin
CheckBox1.Checked:=False;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if (TCheckBox(Controls[i]).Name<>'CheckBox1') and (TCheckBox(Controls[i]).Name<>'CheckBox2') then
begin
TCheckBox(Controls[i]).Checked:=False;
end;
end;
end;
end;
end;
end;
end.

18063
Z99Dependency/ThreeFun/Form/U_SysLogHelp.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

183
Z99Dependency/ThreeFun/Form/U_SysLogHelp.pas Normal file
View File

@ -0,0 +1,183 @@
unit U_SysLogHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, cxStyles, cxCustomData, cxGraphics, cxFilter,
cxData, cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, strUtils,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, ADODB, StdCtrls, ExtCtrls, ImgList,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxSkinsCore,
dxSkinsDefaultPainters, dxSkinscxPCPainter;
type
TfrmSysLogHelp = class(TForm)
ToolBar1: TToolBar;
TQry: TToolButton;
Tclose: TToolButton;
ADOQueryLog: TADOQuery;
DataSource1: TDataSource;
ADOConnection1: TADOConnection;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
tv1OperMan: TcxGridDBColumn;
tv1jopertime: TcxGridDBColumn;
tv1Model: TcxGridDBColumn;
tv1acction: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
tv1Opevent: TcxGridDBColumn;
tv1Result: TcxGridDBColumn;
Panel1: TPanel;
Label2: TLabel;
Label1: TLabel;
begDate: TDateTimePicker;
endDate: TDateTimePicker;
Label3: TLabel;
edt_model: TEdit;
CheckBox1: TCheckBox;
Label4: TLabel;
edt_nr: TEdit;
ThreeImgList: TImageList;
procedure TcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TQryClick(Sender: TObject);
procedure edt_modelChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure DoQuery();
procedure DoFilter();
public
fModel, facction: string;
fOtherWhere: string;
end;
var
frmSysLogHelp: TfrmSysLogHelp;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmSysLogHelp.TcloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmSysLogHelp.FormCreate(Sender: TObject);
begin
cxGrid1.Align := alClient;
begDate.DateTime := date - 31;
endDate.DateTime := date;
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
end;
/////////////////////////////////////////////////////////
//
////////////////////////////////////////////////////////
procedure TfrmSysLogHelp.DoQuery();
var
mbegdate, menddate: string;
begin
mbegdate := formatDatetime('yyyy-MM-dd', begDate.Date); //
menddate := formatDatetime('yyyy-MM-dd', endDate.Date + 1);
try
with ADOQueryLog do
begin
close;
sql.clear;
filtered := false;
sql.add('select A.* ');
sql.add('from SY_sysLog A');
if CheckBox1.Checked then
begin
sql.Add('where OperTime>=' + quotedStr(mbegdate));
sql.Add('and OperTime<' + quotedStr(menddate));
end
else
begin
sql.Add('where 1=1');
end;
if trim(fModel) <> '' then
sql.add('and Model=' + quotedStr(fModel));
if trim(facction) <> '' then
sql.add('and acction=' + quotedStr(facction));
if trim(fOtherWhere) <> '' then
begin
sql.add(fOtherWhere);
end;
sql.Add('order by operOr,Opertime');
Open;
end;
finally
end;
end;
///////////////////////////////////////////////////////////
//
///////////////////////////////////////////////////////////
procedure TfrmSysLogHelp.DoFilter();
var
filterStr: string;
begin
filterStr := '';
//
if trim(edt_model.text) <> '' then
begin
filterStr := ' and model =' + quotedStr(trim(edt_model.text));
end;
if trim(edt_nr.text) <> '' then
begin
filterStr := ' and OpEvent like ' + quotedStr('%' + trim(edt_nr.text) + '%');
end;
try
ADOQueryLog.DisableControls;
if trim(filterStr) = '' then
begin
ADOQueryLog.Filtered := false;
exit;
end;
filterStr := trim(RightBStr(filterStr, length(filterStr) - 4));
with ADOQueryLog do
begin
filtered := false;
filter := filterStr;
filtered := true;
end;
finally
ADOQueryLog.EnableControls;
end;
end;
procedure TfrmSysLogHelp.FormShow(Sender: TObject);
begin
DoQuery();
end;
procedure TfrmSysLogHelp.TQryClick(Sender: TObject);
begin
DoQuery();
end;
procedure TfrmSysLogHelp.edt_modelChange(Sender: TObject);
begin
DoFilter();
end;
procedure TfrmSysLogHelp.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := cafree;
end;
end.

23808
Z99Dependency/ThreeFun/Form/U_UserHelp.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

214
Z99Dependency/ThreeFun/Form/U_UserHelp.pas Normal file
View File

@ -0,0 +1,214 @@
unit U_UserHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, cxFilter,
cxData, cxDataStorage, cxEdit, DB, cxDBData, StdCtrls, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, cxInplaceContainer, cxDBTL,
cxTLData, ComCtrls, ToolWin, ADODB, ImgList,StrUtils, ExtCtrls;
type
TfrmUserHelp = class(TForm)
ToolBar2: TToolBar;
TOk: TToolButton;
TBClose: TToolButton;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
tv1Code: TcxGridDBColumn;
tv1Name: TcxGridDBColumn;
DBGrid1Level1: TcxGridLevel;
GroupBox1: TGroupBox;
ADOQueryDept: TADOQuery;
DataSource1: TDataSource;
ADOConnection1: TADOConnection;
tv1Column1: TcxGridDBColumn;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
cxStyle2: TcxStyle;
cxStyle_gridRow: TcxStyle;
cxStyle_gridFoot: TcxStyle;
cxStyle_gridHead: TcxStyle;
cxStyle_gridGroupBox: TcxStyle;
cxStyle_yellow: TcxStyle;
cxStyle_Red: TcxStyle;
ADOQueryHelp: TADOQuery;
DataSource2: TDataSource;
Label1: TLabel;
Edt_name: TEdit;
ImageList1: TImageList;
cxStyleTree: TcxStyle;
Label2: TLabel;
Edt_Code: TEdit;
Splitter1: TSplitter;
ThreeImgList: TImageList;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TOkClick(Sender: TObject);
procedure tv1DblClick(Sender: TObject);
procedure Edt_nameChange(Sender: TObject);
procedure cxDBTreeList1Click(Sender: TObject);
private
procedure InitTree();
procedure DoQuery();
procedure FilterData(strdepotno,strcode,strname:string);
public
fFrameNo:string;
fFrameName:string;
fIsYwy:boolean;
end;
var
frmUserHelp: TfrmUserHelp;
implementation
uses
U_DataLink;
{$R *.dfm}
///////////////////////////////////////////////////////////
//////功能：过滤数据
///////////////////////////////////////////////////////////
procedure TfrmUserHelp.FilterData(strdepotno,strcode,strname:string);
var
filterStr:string;
begin
filterStr:='';
if trim(strdepotno)<>'' then
filterStr:=filterStr+' and dept like '+quotedstr('%'+trim(strdepotno)+'%');
if trim(strcode)<>'' then
filterStr:=filterStr+' and userID like '+quotedstr('%'+trim(strcode)+'%');
if trim(strname)<>'' then
filterStr:=filterStr+' and userName like '+quotedstr('%'+trim(strname)+'%');
try
ADOQueryHelp.DisableControls ;
if trim(filterStr)='' then
begin
ADOQueryHelp.Filtered:=false;
ADOQueryHelp.EnableControls;
exit;
end;
filterStr:=trim(RightBStr(filterStr,length(filterStr)-5));
// showmessage(filterStr);
with ADOQueryHelp do
begin
filtered:=false;
filter:=filterStr;
filtered:=true;
end;
finally
ADOQueryHelp.EnableControls;
end;
end;
//////////////////////////////////////////////////////
procedure TfrmUserHelp.InitTree();
var
strsql,strwhere:string;
begin
strsql:=' SELECT distinct UDept=''ALL'',UDeptTop='''',UDeptName=''所有部门'',Framelevel=0 '+
' union '+
' SELECT distinct UDept,UDeptTop=''ALL'',UDept,Framelevel=1 '+
' FROM BD_staff A '+
' WHERE USERID<>''ADMIN'' and ISNULL(UDept,'''')<>'''' ';
strwhere:=' where A.Valid=''Y'' ';
{ if fIsYwy then
strwhere:=strwhere+' and A.YWYFlag=''Y'' ';
if trim(fFrameNo)<>'' then
strwhere:=strwhere+' and A.dept='+quotedstr(trim(fFrameNo));
if trim(fFrameName)<>'' then
strwhere:=strwhere+' and B.frameName like '+quotedstr('%'+trim(fFrameName)+'%');
strsql:=strsql+ strwhere; }
with ADOQueryDept do
begin
close;
sql.Clear ;
sql.Add( strsql);
Open;
end;
cxDBTreeList1.FullExpand;
DoQuery();
end;
procedure TfrmUserHelp.FormShow(Sender: TObject);
begin
InitTree();
end;
procedure TfrmUserHelp.FormCreate(Sender: TObject);
begin
cxGrid1.Align :=alclient;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
Connected:=true;
end;
end;
//////////////////////////////////////////////////
//
//////////////////////////////////////////////////
procedure TfrmUserHelp.DoQuery();
var
strsql,strwhere:string;
begin
strsql:=' select * '+
' from BD_staff A '+
' where isnull(UserID,'''')<>''ADMIN'' ';
strwhere:=' and A.Valid=''Y'' ';
if fIsYwy then
strwhere:=strwhere+' and A.Isywy=1 ';
strsql:=strsql+ strwhere +' order by A.userID ';
with ADOQueryHelp do
begin
close;
sql.Clear ;
sql.Add( strsql);
Open;
end;
end;
procedure TfrmUserHelp.TBCloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmUserHelp.TOkClick(Sender: TObject);
begin
if ADOQueryHelp.IsEmpty then
begin
ModalResult:=-1
end
else
ModalResult:=1;
end;
procedure TfrmUserHelp.tv1DblClick(Sender: TObject);
begin
Tok.Click ;
end;
procedure TfrmUserHelp.Edt_nameChange(Sender: TObject);
begin
FilterData('',edt_code.Text,Edt_name.Text);
end;
procedure TfrmUserHelp.cxDBTreeList1Click(Sender: TObject);
begin
if ADOQueryDept.IsEmpty then exit;
if trim(ADOQueryDept.FieldByName('Framelevel').AsString)='0' then
FilterData('','','')
else
FilterData(ADOQueryDept.FieldByName('UDept').AsString,'','');
end;
end.

23877
Z99Dependency/ThreeFun/Form/U_UserHelp_Dx.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

245
Z99Dependency/ThreeFun/Form/U_UserHelp_Dx.pas Normal file
View File

@ -0,0 +1,245 @@
unit U_UserHelp_Dx;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, cxFilter,
cxData, cxDataStorage, cxEdit, DB, cxDBData, StdCtrls, cxGridLevel,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, cxInplaceContainer, cxDBTL,
cxTLData, ComCtrls, ToolWin, ADODB, ImgList,StrUtils, ExtCtrls, DBClient;
type
TfrmUserHelp_Dx = class(TForm)
ToolBar2: TToolBar;
TOk: TToolButton;
TBClose: TToolButton;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
tv1Code: TcxGridDBColumn;
tv1Name: TcxGridDBColumn;
DBGrid1Level1: TcxGridLevel;
GroupBox1: TGroupBox;
ADOQueryDept: TADOQuery;
DataSource1: TDataSource;
ADOConnection1: TADOConnection;
tv1Column1: TcxGridDBColumn;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
cxStyle2: TcxStyle;
cxStyle_gridRow: TcxStyle;
cxStyle_gridFoot: TcxStyle;
cxStyle_gridHead: TcxStyle;
cxStyle_gridGroupBox: TcxStyle;
cxStyle_yellow: TcxStyle;
cxStyle_Red: TcxStyle;
ADOQueryHelp: TADOQuery;
DataSource2: TDataSource;
Label1: TLabel;
Edt_name: TEdit;
ImageList1: TImageList;
cxStyleTree: TcxStyle;
Label2: TLabel;
Edt_Code: TEdit;
ThreeImgList: TImageList;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
cxGridDBColumn3: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
GroupBox2: TGroupBox;
CDS_sel: TClientDataSet;
DataSourceSel: TDataSource;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
Splitter1: TSplitter;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TOkClick(Sender: TObject);
procedure tv1DblClick(Sender: TObject);
procedure Edt_nameChange(Sender: TObject);
procedure cxDBTreeList1Click(Sender: TObject);
procedure Tv2DblClick(Sender: TObject);
private
procedure InitTree();
procedure DoQuery();
procedure FilterData(strdepotno,strcode,strname:string);
public
fFrameNo:string;
fFrameName:string;
fIsYwy:boolean;
end;
var
frmUserHelp_Dx: TfrmUserHelp_Dx;
implementation
uses
U_DataLink,U_Fun10;
{$R *.dfm}
///////////////////////////////////////////////////////////
//////功能：过滤数据
///////////////////////////////////////////////////////////
procedure TfrmUserHelp_Dx.FilterData(strdepotno,strcode,strname:string);
var
filterStr:string;
begin
filterStr:='';
if trim(strdepotno)<>'' then
filterStr:=filterStr+' and dept like '+quotedstr('%'+trim(strdepotno)+'%');
if trim(strcode)<>'' then
filterStr:=filterStr+' and userID like '+quotedstr('%'+trim(strcode)+'%');
if trim(strname)<>'' then
filterStr:=filterStr+' and userName like '+quotedstr('%'+trim(strname)+'%');
try
ADOQueryHelp.DisableControls ;
if trim(filterStr)='' then
begin
ADOQueryHelp.Filtered:=false;
ADOQueryHelp.EnableControls;
exit;
end;
filterStr:=trim(RightBStr(filterStr,length(filterStr)-5));
// showmessage(filterStr);
with ADOQueryHelp do
begin
filtered:=false;
filter:=filterStr;
filtered:=true;
end;
finally
ADOQueryHelp.EnableControls;
end;
end;
//////////////////////////////////////////////////////
procedure TfrmUserHelp_Dx.InitTree();
var
strsql,strwhere:string;
begin
strsql:=' SELECT distinct UDept=''ALL'',UDeptTop='''',UDeptName=''所有部门'',Framelevel=0 '+
' union '+
' SELECT distinct UDept,UDeptTop=''ALL'',UDept,Framelevel=1 '+
' FROM BD_staff A '+
' WHERE USERID<>''ADMIN'' and ISNULL(UDept,'''')<>'''' ';
strwhere:=' where A.Valid=''Y'' ';
{ if fIsYwy then
strwhere:=strwhere+' and A.YWYFlag=''Y'' ';
if trim(fFrameNo)<>'' then
strwhere:=strwhere+' and A.dept='+quotedstr(trim(fFrameNo));
if trim(fFrameName)<>'' then
strwhere:=strwhere+' and B.frameName like '+quotedstr('%'+trim(fFrameName)+'%');
strsql:=strsql+ strwhere; }
with ADOQueryDept do
begin
close;
sql.Clear ;
sql.Add( strsql);
Open;
end;
cxDBTreeList1.FullExpand;
DoQuery();
end;
procedure TfrmUserHelp_Dx.FormShow(Sender: TObject);
begin
InitTree();
end;
procedure TfrmUserHelp_Dx.FormCreate(Sender: TObject);
begin
GroupBox2.Align :=alclient;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
Connected:=true;
end;
end;
//////////////////////////////////////////////////
//
//////////////////////////////////////////////////
procedure TfrmUserHelp_Dx.DoQuery();
var
strsql,strwhere:string;
begin
strsql:=' select * '+
' from BD_staff A '+
' where isnull(UserID,'''')<>''ADMIN'' ';
strwhere:=' and A.Valid=''Y'' ';
if fIsYwy then
strwhere:=strwhere+' and A.Isywy=1 ';
strsql:=strsql+ strwhere +' order by A.userID ';
with ADOQueryHelp do
begin
close;
sql.Clear ;
sql.Add( strsql);
Open;
end;
sCreateCDS20(ADOQueryHelp,cds_sel);
end;
procedure TfrmUserHelp_Dx.TBCloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmUserHelp_Dx.TOkClick(Sender: TObject);
begin
if ADOQueryHelp.IsEmpty then
begin
ModalResult:=-1
end
else
ModalResult:=1;
end;
procedure TfrmUserHelp_Dx.tv1DblClick(Sender: TObject);
var
i:integer;
begin
if ADOQueryHelp.IsEmpty then exit;
if CDS_Sel.Locate('userID',trim(adoqueryHelp.fieldbyname('userID').AsString),[]) then exit;
with CDS_Sel do
begin
CDS_Sel.append;
for i:=0 to ADOQueryHelp.FieldCount-1 do
begin
fields[i].Value:=ADOQueryHelp.Fields[i].Value;
end;
CDS_Sel.Post;
end;
end;
procedure TfrmUserHelp_Dx.Edt_nameChange(Sender: TObject);
begin
FilterData('',edt_code.Text,Edt_name.Text);
end;
procedure TfrmUserHelp_Dx.cxDBTreeList1Click(Sender: TObject);
begin
if ADOQueryDept.IsEmpty then exit;
if trim(ADOQueryDept.FieldByName('Framelevel').AsString)='0' then
FilterData('','','')
else
FilterData(ADOQueryDept.FieldByName('UDept').AsString,'','');
end;
procedure TfrmUserHelp_Dx.Tv2DblClick(Sender: TObject);
begin
IF cds_sel.IsEmpty then exit;
cds_sel.Delete;
end;
end.

63
Z99Dependency/ThreeFun/Form/U_YPTypeHelp.dfm Normal file
View File

@ -0,0 +1,63 @@
object frmYPTypeHelp: TfrmYPTypeHelp
Left = 320
Top = 178
Width = 371
Height = 524
Caption = #26679#21697#31867#21035#36873#25321#21015#34920
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object cxDBTreeList1: TcxDBTreeList
Left = 0
Top = 0
Width = 249
Height = 486
Align = alLeft
Bands = <
item
end>
BufferedPaint = False
DataController.DataSource = DataSource1
DataController.ParentField = 'CPParent'
DataController.KeyField = 'CPID'
OptionsBehavior.ExpandOnDblClick = False
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
TabOrder = 0
OnDblClick = cxDBTreeList1DblClick
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'CPName'
Width = 210
Position.ColIndex = 1
Position.RowIndex = 0
Position.BandIndex = 0
end
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 288
Top = 60
end
object DataSource1: TDataSource
DataSet = ADOQueryHelp
Left = 280
Top = 188
end
object ADOQueryHelp: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 288
Top = 136
end
end

70
Z99Dependency/ThreeFun/Form/U_YPTypeHelp.pas Normal file
View File

@ -0,0 +1,70 @@
unit U_YPTypeHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, DB, ADODB;
type
TfrmYPTypeHelp = class(TForm)
ADOConnection1: TADOConnection;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DataSource1: TDataSource;
ADOQueryHelp: TADOQuery;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmYPTypeHelp: TfrmYPTypeHelp;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmYPTypeHelp.FormCreate(Sender: TObject);
begin
cxDBTreeList1.Align := alclient;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
//ConnectionString:='';
Connected := true;
end;
except
end;
end;
procedure TfrmYPTypeHelp.FormShow(Sender: TObject);
begin
with ADOQueryHelp do
begin
Close;
SQL.Clear;
SQL.Add('select * from CP_Type where FLType=''ÑùÆ·Àà±ð'' order by CPlevel,CPOrder,CPName');
Open;
end;
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmYPTypeHelp.cxDBTreeList1DblClick(Sender: TObject);
begin
if ADOQueryHelp.IsEmpty then
exit;
ModalResult := 1;
end;
end.

18081
Z99Dependency/ThreeFun/Form/U_ZDYHelp.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

697
Z99Dependency/ThreeFun/Form/U_ZDYHelp.pas Normal file
View File

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

18083
Z99Dependency/ThreeFun/Form/U_ZDYHelpDL.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

294
Z99Dependency/ThreeFun/Form/U_ZDYHelpDL.pas Normal file
View File

@ -0,0 +1,294 @@
unit U_ZDYHelpDL;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel,
cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList,
StdCtrls, ExtCtrls, cxTL, cxMaskEdit, cxInplaceContainer, cxDBTL,
cxTLData, cxDropDownEdit;
type
TfrmZDYDLHelp = class(TForm)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
V1Code: TcxGridDBColumn;
V1Name: TcxGridDBColumn;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
TBAdd: TToolButton;
TBSave: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
TBEdit: TToolButton;
V1Note: TcxGridDBColumn;
V1OrderNo: TcxGridDBColumn;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
ZDYName: TEdit;
ThreeImgList: TImageList;
ADOQueryChild: TADOQuery;
DataSource2: TDataSource;
cxDBTreeList1: TcxDBTreeList;
cxColumn2: TcxDBTreeListColumn;
V1Column1: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBAddClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
procedure ZDYNameChange(Sender: TObject);
procedure cxDBTreeList1Click(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
MainType,MainTypeName,flag,flagname,snote:string;
fnote,forderno:Boolean;
{ Public declarations }
end;
var
frmZDYDLHelp: TfrmZDYDLHelp;
implementation
uses
U_DataLink,U_Fun;
{$R *.dfm}
procedure TfrmZDYDLHelp.FormCreate(Sender: TObject);
begin
cxGrid1.Align:=alClient;
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
Connected:=true;
end;
end;
procedure TfrmZDYDLHelp.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmZDYDLHelp.InitGrid();
begin
try
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.*,TypeName=(select ZdyName from KH_Zdy B where B.ZdyNO=A.Type) from KH_Zdy A');
if Trim(ADOQueryChild.fieldbyname('frameNo').AsString)<>'QB' then
sql.Add('where Type='''+Trim(ADOQueryChild.fieldbyname('frameNo').AsString)+'''')
else
sql.Add('where MainType='''+Trim(MainType)+''' and Type<>''Main'' ');
Open;
end;
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmZDYDLHelp.TBAddClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
with ClientDataSet1 do
begin
Append;
Post;
end;
end;
procedure TfrmZDYDLHelp.TBSaveClick(Sender: TObject);
var
maxno,fsj:string;
i:Integer;
begin
if ClientDataSet1.IsEmpty then Exit;
if Trim(ClientDataSet1.fieldbyname('ZdyName').AsString)='' then
begin
Application.MessageBox('名称不能为空！','提示',0);
Exit;
end;
if Trim(ClientDataSet1.fieldbyname('TypeName').AsString)='' then
begin
Application.MessageBox('类别不能为空！','提示',0);
Exit;
end;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
with ClientDataSet1 do
begin
First;
while not eof do
begin
if Trim(ClientDataSet1.FieldByName('ZDYNO').AsString)='' then
begin
if GetLSNo(ADOQueryTemp,maxno,'SY','KH_ZDY',3,1)=False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大编号失败！','提示',0);
Exit;
end;
end else
begin
maxno:=Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
SQL.Add('delete KH_ZDY where ZDYNO='''+Trim(ClientDataSet1.fieldbyname('ZDYNO').AsString)+'''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from KH_ZDY where 1<>1');
Open;
end;
if Trim(ClientDataSet1.FieldByName('ZDYName').AsString)='' then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('名称不能为空！','提示',0);
Exit;
end;
ADOQueryCmd.Append;
ADOQueryCmd.FieldByName('ZDYNo').Value:=Trim(maxno);
ADOQueryCmd.FieldByName('ZDYName').Value:=ClientDataSet1.fieldbyname('ZDYName').AsString;
ADOQueryCmd.FieldByName('note').Value:=Trim(snote);
//ADOQueryCmd.FieldByName('orderno').Value:=ClientDataSet1.fieldbyname('Name').AsString;
// ADOQueryCmd.FieldByName('Type').Value:=TcxComboBox(V1Column1).Properties.Items.Strings[1];
i:=(V1Column1.Properties as TcxComboBoxProperties).Items.IndexOf(ClientDataSet1.fieldbyname('TypeName').AsString);
fsj:=TA((V1Column1.Properties as TcxComboBoxProperties).Items.Objects[i]).S;
ADOQueryCmd.FieldByName('Type').Value:=Trim(fsj);
ADOQueryCmd.FieldByName('valid').Value:='Y';
ADOQueryCmd.FieldByName('Maintype').Value:=Trim(MainType);
//ADOQueryCmd.FieldByName('sel').Value:=0;
ADOQueryCmd.Post;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('ZDYNo').Value:=Trim(maxno);
ClientDataSet1.Post;
Next;
end;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
Application.MessageBox('保存成功！','提示',0);
except
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败！','提示',0);
end;
TV1.OptionsData.Editing:=False;
end;
procedure TfrmZDYDLHelp.TBDelClick(Sender: TObject);
begin
if ClientDataSet1.IsEmpty then Exit;
if (Trim(ClientDataSet1.FieldByName('ZDYNo').AsString)<>'') or
(Trim(ClientDataSet1.FieldByName('ZDYname').AsString)<>'') then
begin
if application.MessageBox('确定要删除吗?','提示信息',1)=2 then exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete KH_ZDY where ZDYNo='''+Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString)+'''');
SQL.Add(' and Type='''+Trim(ADOQueryChild.fieldbyname('frameNO').AsString)+'''');
ExecSQL;
end;
end;
ClientDataSet1.Delete;
end;
procedure TfrmZDYDLHelp.TBCloseClick(Sender: TObject);
begin
ModalResult:=2;
Close;
end;
procedure TfrmZDYDLHelp.FormShow(Sender: TObject);
var
fsj,fsj1:string;
begin
fsj:='select ZdyNo code,ZdyName name from KH_Zdy where MainType='''+MainType+''' and Type=''Main''';
SInitCxGridComboBoxBySql(ADOQueryTemp,V1Column1,fsj,1,True,'');
fsj:= ' select frameNo=''QB'',frameName=''全部'',TopFrameNo='''+Trim(MainType)+''''+
' union all select frameNo=ZdyNo,frameName=ZdyName,TopFrameNo=MainType '+
' from KH_Zdy A '+
' where A.MainType='''+MainType+''' and Type=''Main''';
with ADOQueryChild do
begin
Close;
sql.Clear;
sql.Add(fsj);
Open;
end;
cxDBTreeList1.FullExpand;
InitGrid();
frmZDYDLHelp.Caption:=Trim(MainTypename)+'<'+Trim(MainType)+'>';
end;
procedure TfrmZDYDLHelp.ToolButton1Click(Sender: TObject);
begin
ModalResult:=1;
end;
procedure TfrmZDYDLHelp.TBEditClick(Sender: TObject);
begin
TV1.OptionsData.Editing:=True;
end;
procedure TfrmZDYDLHelp.TV1CellDblClick(Sender: TcxCustomGridTableView;
ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
AShift: TShiftState; var AHandled: Boolean);
begin
if TV1.OptionsData.Editing=False then
begin
ModalResult:=1;
end;
end;
procedure TfrmZDYDLHelp.ZDYNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain,SGetFilters(Panel1,1,2));
SCreateCDS20(ADOQueryMain,ClientDataSet1);
SInitCDSData20(ADOQueryMain,ClientDataSet1);
end;
end;
procedure TfrmZDYDLHelp.cxDBTreeList1Click(Sender: TObject);
begin
InitGrid();
end;
end.

18067
Z99Dependency/ThreeFun/Form/U_ZDYHelpSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

497
Z99Dependency/ThreeFun/Form/U_ZDYHelpSel.pas Normal file
View File

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

330
Z99Dependency/ThreeFun/Form/U_ZdyAttachGYSHelp.dfm Normal file
View File

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

211
Z99Dependency/ThreeFun/Form/U_ZdyAttachGYSHelp.pas Normal file
View File

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

332
Z99Dependency/ThreeFun/Form/U_ZdyAttachmentHelp.dfm Normal file
View File

@ -0,0 +1,332 @@
object frmZdyAttachmentHelp: TfrmZdyAttachmentHelp
Left = 157
Top = 76
Width = 1064
Height = 652
Caption = #23458#25143#36164#26009#31649#29702
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1048
Height = 31
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_TradeManage.ThreeImgList
Flat = True
Images = DataLink_TradeManage.ThreeImgList
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 9
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 59
OnClick = ToolButton2Click
end
object ToolButton3: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #26032#22686
ImageIndex = 3
Visible = False
end
object ToolButton4: TToolButton
Left = 189
Top = 0
Caption = #20462#25913
ImageIndex = 54
Visible = False
OnClick = ToolButton4Click
end
object TBDel: TToolButton
Left = 248
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 17
Visible = False
OnClick = TBDelClick
end
object ToolButton1: TToolButton
Left = 311
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 53
Visible = False
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 374
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 55
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 31
Width = 1048
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label3: TLabel
Left = 190
Top = 13
Width = 48
Height = 12
Caption = #23458#25143#21517#31216
end
object Label1: TLabel
Left = 22
Top = 13
Width = 48
Height = 12
Caption = #23458#25143#32534#21495
end
object Label2: TLabel
Left = 350
Top = 13
Width = 36
Height = 12
Caption = #19994#21153#21592
end
object ZdyName: TEdit
Tag = 2
Left = 238
Top = 9
Width = 89
Height = 20
TabOrder = 0
OnChange = ZdyNameChange
end
object ZdyCode: TEdit
Tag = 2
Left = 70
Top = 9
Width = 89
Height = 20
TabOrder = 1
OnChange = ZdyNameChange
end
object DEFstr5: TEdit
Tag = 2
Left = 388
Top = 9
Width = 89
Height = 20
TabOrder = 2
OnChange = ZdyNameChange
end
end
object cxGrid2: TcxGrid
Left = 0
Top = 70
Width = 1048
Height = 544
Align = alClient
TabOrder = 2
object Tv2: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
NavigatorButtons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False
OnCellDblClick = Tv2CellDblClick
DataController.DataSource = DS_HZ
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsSelection.CellSelect = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_TradeManage.SHuangSe
Styles.IncSearch = DataLink_TradeManage.SHuangSe
Styles.Selection = DataLink_TradeManage.SHuangSe
Styles.Header = DataLink_TradeManage.handBlack
object v2Column2: TcxGridDBColumn
Caption = #23458#25143#32534#21495
DataBinding.FieldName = 'ZdyCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 86
end
object v2Column6: TcxGridDBColumn
Caption = #23458#25143#21517#31216
DataBinding.FieldName = 'ZdyName'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Width = 127
end
object v2Column10: TcxGridDBColumn
Caption = #19994#21153#21592
DataBinding.FieldName = 'DEFstr5'
HeaderAlignmentHorz = taCenter
Width = 56
end
object v2Column3: TcxGridDBColumn
Caption = #30005#35805
DataBinding.FieldName = 'DEFstr1'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 71
end
object v2Column4: TcxGridDBColumn
Caption = #25163#26426
DataBinding.FieldName = 'DEFstr2'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 74
end
object v2Column5: TcxGridDBColumn
Caption = #20256#30495
DataBinding.FieldName = 'DEFstr3'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 68
end
object v2Column7: TcxGridDBColumn
Caption = #20844#21496#22320#22336
DataBinding.FieldName = 'DEFNote1'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 67
end
object v2Column8: TcxGridDBColumn
Caption = #21457#36135#22320#22336
DataBinding.FieldName = 'DEFNote2'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 72
end
object v2Column9: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'DEFstr4'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 73
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 165
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_TradeManage.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 789
Top = 9
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_TradeManage.ADOLink
Parameters = <>
Left = 829
Top = 1
end
object ADOQueryMain: TADOQuery
Connection = DataLink_TradeManage.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 949
Top = 225
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDB_Main
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 864
Top = 224
ReportData = {}
end
object RMDB_Main: TRMDBDataSet
Visible = True
Left = 928
Top = 216
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 888
Top = 224
end
object DS_HZ: TDataSource
DataSet = CDS_HZ
Left = 899
Top = 235
end
object CDS_HZ: TClientDataSet
Aggregates = <>
Params = <>
Left = 872
Top = 224
end
end

201
Z99Dependency/ThreeFun/Form/U_ZdyAttachmentHelp.pas Normal file
View File

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

1944
Z99Dependency/ThreeFun/Fun/SPCOMM.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

633
Z99Dependency/ThreeFun/Fun/U_CPBCKKCSel.dfm Normal file
View File

@ -0,0 +1,633 @@
object frmCPBCKKCSel: TfrmCPBCKKCSel
Left = 506
Top = 220
Width = 1181
Height = 511
Align = alClient
Caption = #25104#21697#24067#24211#23384#36873#25321
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 1165
Height = 33
ButtonHeight = 30
ButtonWidth = 59
Caption = 'ToolBar1'
Color = clSkyBlue
Flat = True
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_PBMDDJ.ThreeImgList
List = True
ParentColor = False
ParentFont = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 0
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 63
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 20
OnClick = TBFindClick
end
object ToolButton1: TToolButton
Left = 126
Top = 0
AutoSize = True
Caption = #30830#23450
ImageIndex = 31
Visible = False
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 189
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 21
OnClick = TBCloseClick
end
end
object Panel1: TPanel
Left = 0
Top = 33
Width = 1165
Height = 60
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label3: TLabel
Left = 199
Top = 12
Width = 24
Height = 12
Caption = #21697#21517
end
object Label4: TLabel
Left = 340
Top = 12
Width = 36
Height = 12
Caption = #21152#24037#21378
end
object Label5: TLabel
Left = 26
Top = 12
Width = 48
Height = 12
Caption = #20837#24211#21333#21495
end
object Label8: TLabel
Left = 199
Top = 36
Width = 24
Height = 12
Caption = #35268#26684
end
object Label12: TLabel
Left = 27
Top = 36
Width = 48
Height = 12
Caption = #20837#24211#31867#22411
end
object Label6: TLabel
Left = 340
Top = 36
Width = 36
Height = 12
Caption = #25104' '#20998
end
object Label7: TLabel
Left = 470
Top = 12
Width = 48
Height = 12
Caption = #35746' '#21333' '#21495
end
object Label1: TLabel
Left = 470
Top = 36
Width = 48
Height = 12
Caption = #23384#25918#24037#21378
end
object Label2: TLabel
Left = 646
Top = 36
Width = 48
Height = 12
Caption = #24211' '#20301
end
object Label9: TLabel
Left = 646
Top = 12
Width = 48
Height = 12
Caption = #26579#21378#32568#21495
end
object Label10: TLabel
Left = 774
Top = 36
Width = 24
Height = 12
Caption = #39068#33394
end
object SPName: TEdit
Tag = 2
Left = 226
Top = 9
Width = 100
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 0
OnChange = TBFindClick
end
object FactoryName: TEdit
Tag = 2
Left = 378
Top = 9
Width = 78
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 1
OnChange = FactoryNameChange
end
object SPID: TEdit
Tag = 2
Left = 76
Top = 9
Width = 109
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 2
OnChange = TBFindClick
end
object SPSpec: TEdit
Tag = 2
Left = 226
Top = 32
Width = 100
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 3
OnChange = TBFindClick
end
object CRType: TComboBox
Tag = 2
Left = 76
Top = 32
Width = 109
Height = 20
Style = csDropDownList
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
ItemHeight = 12
TabOrder = 4
OnChange = TBFindClick
Items.Strings = (
#21152#24037#23436#25104
#22238#20462#23436#25104
#26816#39564#36864#22238
#26399#21021#20837#24211
'')
end
object SPCF: TEdit
Tag = 2
Left = 378
Top = 32
Width = 78
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 5
OnChange = FactoryNameChange
end
object OrderNo: TEdit
Tag = 2
Left = 519
Top = 9
Width = 108
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 6
OnChange = FactoryNameChange
end
object ToFactoryName: TEdit
Tag = 2
Left = 519
Top = 33
Width = 108
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 7
OnChange = FactoryNameChange
end
object KuWei: TEdit
Tag = 2
Left = 694
Top = 32
Width = 65
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 8
OnChange = FactoryNameChange
end
object RCGangNo: TEdit
Tag = 2
Left = 694
Top = 8
Width = 65
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 9
OnChange = FactoryNameChange
end
object SPColor: TEdit
Tag = 2
Left = 799
Top = 32
Width = 65
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 10
OnChange = FactoryNameChange
end
end
object cxGrid2: TcxGrid
Left = 0
Top = 93
Width = 1165
Height = 380
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 2
object Tv1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skCount
end
item
Kind = skSum
end
item
Kind = skSum
Column = v2Column6
end
item
Kind = skSum
end
item
Kind = skSum
Column = v1Column9
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Inactive = DataLink_PBMDDJ.SHuangSe
Styles.IncSearch = DataLink_PBMDDJ.SHuangSe
Styles.Selection = DataLink_PBMDDJ.SHuangSe
Styles.Header = DataLink_PBMDDJ.Default
object v1Column20: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
Properties.NullStyle = nssUnchecked
HeaderAlignmentHorz = taCenter
Width = 44
end
object v1Column6: TcxGridDBColumn
Caption = #20837#24211#21333#21495
DataBinding.FieldName = 'SPID'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 83
end
object v1Column2: TcxGridDBColumn
Tag = 2
Caption = #20837#24211#26102#38388
DataBinding.FieldName = 'CRTime'
PropertiesClassName = 'TcxDateEditProperties'
Properties.SaveTime = False
Properties.ShowTime = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 93
end
object v1Column4: TcxGridDBColumn
Tag = 2
Caption = #20837#24211#31867#22411
DataBinding.FieldName = 'CRType'
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#27491#24120#20837#24211
#29983#20135#36864#22238
#26399#21021#20837#24211)
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 81
end
object v1Column13: TcxGridDBColumn
Caption = #35746#21333#21495
DataBinding.FieldName = 'OrderNo'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 95
end
object v1Column14: TcxGridDBColumn
Tag = 2
Caption = #21152#24037#21378
DataBinding.FieldName = 'FactoryName'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Alignment.Horz = taLeftJustify
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 103
end
object v1Column15: TcxGridDBColumn
Caption = #39068#33394
DataBinding.FieldName = 'SPColor'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 116
end
object v1Column22: TcxGridDBColumn
Caption = #23458#25143
DataBinding.FieldName = 'CustomerNoName'
HeaderAlignmentHorz = taCenter
Width = 83
end
object v1Column21: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'spcode'
HeaderAlignmentHorz = taCenter
Width = 82
end
object v2Column1: TcxGridDBColumn
Tag = 2
Caption = #21697#21517
DataBinding.FieldName = 'SPName'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 97
end
object v1Column8: TcxGridDBColumn
Tag = 2
Caption = #35268#26684
DataBinding.FieldName = 'SPSpec'
HeaderAlignmentHorz = taCenter
HeaderGlyphAlignmentHorz = taCenter
Options.Editing = False
Width = 65
end
object v1Column7: TcxGridDBColumn
Tag = 2
Caption = #25104#20998
DataBinding.FieldName = 'SPCF'
HeaderAlignmentHorz = taCenter
HeaderGlyphAlignmentHorz = taCenter
Options.Editing = False
Width = 73
end
object v1Column1: TcxGridDBColumn
Tag = 2
Caption = #38376#24133
DataBinding.FieldName = 'SPMF'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 73
end
object v1Column10: TcxGridDBColumn
Caption = #20811#37325
DataBinding.FieldName = 'SPKZ'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 90
end
object v1Column16: TcxGridDBColumn
Caption = #26469#33258#24037#21378
DataBinding.FieldName = 'FromFactoryName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 100
end
object v1Column11: TcxGridDBColumn
Tag = 2
Caption = #23384#25918#24037#21378
DataBinding.FieldName = 'ToFactoryName'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
Properties.ReadOnly = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 90
end
object v1Column18: TcxGridDBColumn
Caption = #24211#20301
DataBinding.FieldName = 'KuWei'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 76
end
object v1Column19: TcxGridDBColumn
Caption = #26579#21378#32568#21495
DataBinding.FieldName = 'RCGangNo'
Options.Editing = False
Width = 67
end
object v1Column9: TcxGridDBColumn
Tag = 2
Caption = #24211#23384#21305#25968
DataBinding.FieldName = 'MXKCPiQty'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 67
end
object v2Column6: TcxGridDBColumn
Tag = 2
Caption = #24211#23384#25968#37327
DataBinding.FieldName = 'MXKCQty'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 85
end
object v1Column3: TcxGridDBColumn
Tag = 2
Caption = #25968#37327#21333#20301
DataBinding.FieldName = 'QtyUnit'
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
'Kg'
'M'
'Y')
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object v1Column12: TcxGridDBColumn
Tag = 2
Caption = #22791#27880
DataBinding.FieldName = 'Note'
Options.Editing = False
Width = 79
end
end
object cxGrid2Level1: TcxGridLevel
GridView = Tv1
end
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
Parameters = <>
Left = 792
end
object ADOQueryMain: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 824
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_PBMDDJ.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 760
end
object DataSource1: TDataSource
DataSet = CDS_Main
Left = 920
Top = 152
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 888
Top = 152
end
object CDS_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 952
Top = 152
end
object RM1: TRMGridReport
ThreadPrepareReport = True
InitialZoom = pzDefault
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbPageSetup, pbExit, pbExport, pbNavigator]
DefaultCollate = False
SaveReportOptions.RegistryPath = 'Software\ReportMachine\ReportSettings\'
PreviewOptions.RulerUnit = rmutScreenPixels
PreviewOptions.RulerVisible = False
PreviewOptions.DrawBorder = False
PreviewOptions.BorderPen.Color = clGray
PreviewOptions.BorderPen.Style = psDash
Dataset = RMDBMain
CompressLevel = rmzcFastest
CompressThread = False
LaterBuildEvents = True
OnlyOwnerDataSet = False
Left = 360
Top = 232
ReportData = {}
end
object RMDBMain: TRMDBDataSet
Visible = True
DataSet = CDS_PRT
Left = 424
Top = 232
end
object RMXLSExport1: TRMXLSExport
ShowAfterExport = True
ExportPrecision = 1
PagesOfSheet = 100
ExportImages = True
ExportFrames = True
ExportImageFormat = ifBMP
JPEGQuality = 0
ScaleX = 1.000000000000000000
ScaleY = 1.000000000000000000
CompressFile = False
Left = 392
Top = 232
end
object RMDBHZ: TRMDBDataSet
Visible = True
DataSet = CDS_HZ
Left = 520
Top = 232
end
object CDS_HZ: TClientDataSet
Aggregates = <>
Params = <>
Left = 488
Top = 232
end
object CDS_PRT: TClientDataSet
Aggregates = <>
Params = <>
Left = 456
Top = 232
end
object PopupMenu1: TPopupMenu
Left = 328
Top = 232
object N1: TMenuItem
Caption = #20840#36873
OnClick = N1Click
end
object N2: TMenuItem
Caption = #20840#24323
OnClick = N2Click
end
end
end

227
Z99Dependency/ThreeFun/Fun/U_CPBCKKCSel.pas Normal file
View File

@ -0,0 +1,227 @@
unit U_CPBCKKCSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, cxGridCustomTableView, cxGridTableView,
cxGridBandedTableView, cxGridDBBandedTableView, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridDBTableView, cxGrid, StdCtrls, ComCtrls,
ExtCtrls, ToolWin, cxGridCustomPopupMenu, cxGridPopupMenu, ADODB, DBClient,
cxDropDownEdit, cxCheckBox, RM_Common, RM_Class, RM_e_Xls, RM_Dataset,
RM_System, RM_GridReport, Menus, cxCalendar, cxButtonEdit, cxTextEdit;
type
TfrmCPBCKKCSel = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBClose: TToolButton;
Panel1: TPanel;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
cxGridPopupMenu1: TcxGridPopupMenu;
CDS_Main: TClientDataSet;
RM1: TRMGridReport;
RMDBMain: TRMDBDataSet;
RMXLSExport1: TRMXLSExport;
RMDBHZ: TRMDBDataSet;
CDS_HZ: TClientDataSet;
CDS_PRT: TClientDataSet;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
ToolButton1: TToolButton;
cxGrid2: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column6: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column4: TcxGridDBColumn;
v1Column13: TcxGridDBColumn;
v1Column14: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
v1Column7: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column11: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v2Column6: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid2Level1: TcxGridLevel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label8: TLabel;
Label12: TLabel;
Label6: TLabel;
Label7: TLabel;
SPName: TEdit;
FactoryName: TEdit;
SPID: TEdit;
SPSpec: TEdit;
CRType: TComboBox;
SPCF: TEdit;
OrderNo: TEdit;
Label1: TLabel;
ToFactoryName: TEdit;
v1Column16: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
Label2: TLabel;
KuWei: TEdit;
v1Column18: TcxGridDBColumn;
v1Column19: TcxGridDBColumn;
Label9: TLabel;
RCGangNo: TEdit;
Label10: TLabel;
SPColor: TEdit;
v1Column20: TcxGridDBColumn;
v1Column21: TcxGridDBColumn;
v1Column22: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBRafreshClick(Sender: TObject);
procedure ConNoMChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBFindClick(Sender: TObject);
procedure MPRTCodeNameChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure SXBatchNOChange(Sender: TObject);
procedure FactoryNameChange(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
private
procedure InitGrid();
{ Private declarations }
public
{ Public declarations }
end;
var
frmCPBCKKCSel: TfrmCPBCKKCSel;
implementation
uses
U_DataLink, U_RTFun, U_SXCKInPut;
{$R *.dfm}
procedure TfrmCPBCKKCSel.FormDestroy(Sender: TObject);
begin
frmDJBCKKCSelList := nil;
end;
procedure TfrmCPBCKKCSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmCPBCKKCSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(' ,OrderNo=(select OrderNo from JYOrder_Main JM where JM.MainId=A.OrdMainIdRK )');
sql.Add(' from CK_SXPB_CR A where isnull(CKName,'''')=''成品布'' ');
SQL.Add(' and A.CRFlag=''入库'' and MXKCQty>0');
Open;
//ShowMessage(SQL.Text);
end;
SCreateCDS20(ADOQueryMain, CDS_Main);
SInitCDSData20(ADOQueryMain, CDS_Main);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCPBCKKCSel.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmCPBCKKCSel.ConNoMChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
end;
end;
procedure TfrmCPBCKKCSel.TBCloseClick(Sender: TObject);
begin
WriteCxGrid('待检布库存选择列表', Tv1, '待检布仓库');
Close;
end;
procedure TfrmCPBCKKCSel.FormShow(Sender: TObject);
begin
ReadCxGrid('待检布库存选择列表', Tv1, '待检布仓库');
//InitGrid();
end;
procedure TfrmCPBCKKCSel.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS20(ADOQueryMain, CDS_Main);
SInitCDSData20(ADOQueryMain, CDS_Main);
end;
end;
procedure TfrmCPBCKKCSel.MPRTCodeNameChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmCPBCKKCSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_Main, True);
end;
procedure TfrmCPBCKKCSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_Main, False);
end;
procedure TfrmCPBCKKCSel.SXBatchNOChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmCPBCKKCSel.FactoryNameChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmCPBCKKCSel.ToolButton1Click(Sender: TObject);
begin
if CDS_Main.IsEmpty then
Exit;
if CDS_Main.Locate('SSel', True, []) = False then
begin
Application.MessageBox('没有选择数据!', '提示', 0);
Exit;
end;
ModalResult := 1;
end;
procedure TfrmCPBCKKCSel.Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
begin
ModalResult := 1;
end;
end.

108
Z99Dependency/ThreeFun/Fun/U_CompressionFun.pas Normal file
View File

@ -0,0 +1,108 @@
unit U_CompressionFun;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, ShlObj, cxShellCommon, cxControls,
cxContainer, cxShellTreeView, cxShellListView, StdCtrls, BtnEdit,
OleCtnrs, DB, ADODB,ZLib;
procedure CompressionStream(var ASrcStream:TMemoryStream;ACompressionLevel:Integer = 2);
procedure UnCompressionStream(var ASrcStream:TMemoryStream);
procedure GetFileInfo(mFile:string;var mfileSize:integer;var CreationTime:tdatetime;var WriteTime:tdatetime);
function CovFileDate(Fd:_FileTime):TDateTime;
implementation
procedure GetFileInfo(mFile:string;var mfileSize:integer;var CreationTime:tdatetime;var WriteTime:tdatetime);
var
vSearchRec: TSearchRec;
begin
FindFirst(mFile,faAnyFile,vSearchRec);
mfileSize:=vSearchRec.Size;
CreationTime:=CovFileDate(vSearchRec.FindData.ftCreationTime);//创建时间
//vSearchRec.FindData.ftLastAccessTime//访问时间
WriteTime:=CovFileDate(vSearchRec.FindData.ftLastWriteTime);//修改时间
FindClose(vSearchRec);
end;
function CovFileDate(Fd:_FileTime):TDateTime;
var
Tct:_SystemTime;
Temp:_FileTime;
begin
FileTimeToLocalFileTime(Fd,Temp);
FileTimeToSystemTime(Temp,Tct);
CovFileDate:=SystemTimeToDateTime(Tct);
end;
////////////////////////////////////////////////////
///////压缩流
////////////////////////////////////////////////////
procedure CompressionStream(var ASrcStream:TMemoryStream;ACompressionLevel:Integer = 2);
var
nDestStream:TMemoryStream;
nTmpStream:TCompressionStream;
nCompressionLevel:TCompressionLevel;
begin
ASrcStream.Position := 0;
nDestStream := TMemoryStream.Create;
try
//级别
case ACompressionLevel of
0:nCompressionLevel := clNone;
1:nCompressionLevel := clFastest;
2:nCompressionLevel := clDefault;
3:nCompressionLevel := clMax;
else
nCompressionLevel := clMax;
end;
//开始压缩
nTmpStream := TCompressionStream.Create(nCompressionLevel,nDestStream);
try
ASrcStream.SaveToStream(nTmpStream);
finally
nTmpStream.Free;//释放后nDestStream才会有数据
end;
ASrcStream.Clear;
ASrcStream.LoadFromStream(nDestStream);
ASrcStream.Position := 0;
finally
nDestStream.Clear;
nDestStream.Free;
end;
end;
////////////////////////////////////////////////////
///////解压缩流
////////////////////////////////////////////////////
procedure UnCompressionStream(var ASrcStream:TMemoryStream);
var
nTmpStream:TDecompressionStream;
nDestStream:TMemoryStream;
nBuf: array[1..512] of Byte;
nSrcCount: integer;
begin
ASrcStream.Position := 0;
nDestStream := TMemoryStream.Create;
nTmpStream := TDecompressionStream.Create(ASrcStream);
try
repeat
//读入实际大小
nSrcCount := nTmpStream.Read(nBuf, SizeOf(nBuf));
if nSrcCount > 0 then
nDestStream.Write(nBuf, nSrcCount);
until (nSrcCount = 0);
ASrcStream.Clear;
ASrcStream.LoadFromStream(nDestStream);
ASrcStream.Position := 0;
finally
nDestStream.Clear;
nDestStream.Free;
nTmpStream.Free;
end;
end;
end.

4546
Z99Dependency/ThreeFun/Fun/U_Fun.pas Normal file
View File

File diff suppressed because it is too large Load Diff

38
Z99Dependency/ThreeFun/Fun/U_Fun10.cfg Normal file
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"d:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"d:\program files (x86)\borland\delphi7\Projects\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

136
Z99Dependency/ThreeFun/Fun/U_Fun10.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=
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=

3395
Z99Dependency/ThreeFun/Fun/U_Fun10.pas Normal file
View File

File diff suppressed because it is too large Load Diff

124
Z99Dependency/ThreeFun/Fun/U_PublicFunction.pas Normal file
View File

@ -0,0 +1,124 @@
unit U_PublicFunction;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit,DBGrids, DB, cxDBData,
cxGridLevel, cxClasses, cxControls, cxGridCustomView, ADODB,StrUtils,
Midas,cxGridCustomTableView, cxGridTableView, cxGridDBTableView,cxTimeEdit,
cxGrid,cxDBLookupComboBox,cxCalendar, cxCurrencyEdit,cxGridExportLink,
ExtCtrls, Buttons,DBClient,FTComboBox,cxDropDownEdit,CXmemo;
function GetMaxBh(ADOQueryTmp:TADOQuery;
var mMaxBh:string;
mBhType:string;
mFlag:string;
mStatus:string;
lsLen:integer=3):Boolean;
procedure CreateAdoToCds(Ado1:TADOQuery; Cds1:TclientDataSet );
procedure InitAdoToCds(Ado1:TADOQuery;Cds1:TclientDataSet);
implementation
function GetMaxBh(ADOQueryTmp:TADOQuery;
var mMaxBh:string;
mBhType:string;
mFlag:string;
mStatus:string;
lsLen:integer=3):Boolean;
begin
try
with ADOQueryTmp do
begin
Close;
sql.Clear ;
sql.Add(' exec Get_SY_MaxBH ');
sql.Add(' @BHstr='+quotedstr(mFlag));
sql.Add(',@BHType='+quotedStr(mBhType));
sql.Add(',@Len='+inttostr(LsLen));
sql.Add(',@status='+quotedStr(mStatus));
Open;
if RecordCount>0 then
begin
mMaxBh:=trim(fieldByName('MaxBH').AsString) ;
if mMaxBh<>'' then
result:=true
else
Result:=false;
end
else
begin
result:=false;
end;
end;
if not Result then
application.MessageBox(Pchar('无法生成自动编号('+mflag+')'),'提示信息',MB_ICONINFORMATION);
Except
result:=false;
application.MessageBox(Pchar('无法生成自动编号('+mflag+')'),'提示信息',MB_ICONINFORMATION);
end;
end;
procedure CreateAdoToCds(Ado1:TADOQuery; Cds1:TclientDataSet );
var
i:integer;
mfieldName:string;
mSize:integer;
begin
mfieldName:='';
Cds1.FieldDefs.Clear;
with Ado1 do
begin
for i:=0 to fieldCount-1 do //
begin
if (Fields[i].DataType=ftString) and (Fields[i].Size=0) then
begin
msize:=1;
end
else
msize:=Fields[i].Size;
mfieldName:=trim(fields[i].FieldName);
Cds1.FieldDefs.Add(mfieldName,Fields[i].DataType,msize);
end;
end;
Cds1.FieldDefs.Add('flag',ftString,1);
Cds1.FieldDefs.Add('index',ftInteger,0);
Cds1.Close;
Cds1.CreateDataSet;
end;
procedure InitAdoToCds(Ado1:TADOQuery;Cds1:TclientDataSet);
var
i:integer;
k:integer;
begin
Ado1.DisableControls;
Cds1.DisableControls;
Ado1.first;
K:=1;
while not Ado1.Eof do
begin
with Cds1 do
begin
Append;
for i:=0 to Ado1.FieldCount-1 do
begin
fields[i].value:=Ado1.Fields[i].Value ;
end;
fieldByName('flag').AsString :='1';
fieldByName('index').value :=k;
inc(k);
Post;
end;
Ado1.Next;
end;
if not Cds1.IsEmpty then
begin
Cds1.First ;
end;
Ado1.EnableControls;
Cds1.EnableControls;
end;
end.

3840
Z99Dependency/ThreeFun/Fun/U_RTFun.pas Normal file
View File

File diff suppressed because it is too large Load Diff

104
Z99Dependency/ThreeFun/Fun/U_SelExportField.dfm Normal file
View File

@ -0,0 +1,104 @@
object frmSelExportField: TfrmSelExportField
Left = 473
Top = 162
BorderStyle = bsDialog
Caption = #23383#27573#23548#20986#36873#25321
ClientHeight = 502
ClientWidth = 422
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Button1: TButton
Left = 94
Top = 456
Width = 75
Height = 21
Caption = #30830#23450
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 243
Top = 456
Width = 75
Height = 21
Caption = #20851#38381
TabOrder = 1
OnClick = Button2Click
end
object cxGrid1: TcxGrid
Left = 329
Top = 151
Width = 200
Height = 162
TabOrder = 2
Visible = False
object ExpGrid: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
DataController.DataSource = ExportDataSource
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.AlwaysShowEditor = True
OptionsView.GroupByBox = False
end
object cxGrid1Level1: TcxGridLevel
GridView = ExpGrid
end
end
object Panel2: TScrollBox
Left = 2
Top = 0
Width = 423
Height = 438
HorzScrollBar.Visible = False
Color = clSkyBlue
ParentColor = False
TabOrder = 3
object Label4: TLabel
Left = 158
Top = 9
Width = 60
Height = 14
Caption = #23383#27573#36873#25321
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
end
object CheckBox1: TCheckBox
Left = 20
Top = 449
Width = 49
Height = 17
Caption = #20840#36873
TabOrder = 4
OnClick = CheckBox1Click
end
object CheckBox2: TCheckBox
Left = 20
Top = 465
Width = 49
Height = 17
Caption = #20840#24323
TabOrder = 5
OnClick = CheckBox2Click
end
object ExportDataSource: TDataSource
Left = 424
Top = 233
end
end

277
Z99Dependency/ThreeFun/Fun/U_SelExportField.pas Normal file
View File

@ -0,0 +1,277 @@
unit U_SelExportField;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids, DBGrids, RM_FormReport, RM_PDBGrid,
DB,IniFiles, RM_Common, RM_Class, RM_e_Xls, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData,
cxGridLevel, cxClasses, cxControls, cxGridCustomView,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator;
type
TfrmSelExportField = class(TForm)
Button1: TButton;
Button2: TButton;
ExportDataSource: TDataSource;
ExpGrid: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
Panel2: TScrollBox;
Label4: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
private
procedure CreateCheckBox();
procedure ExportData();
procedure ReadINIFile(fieldname:string);
procedure WriteINIFile(fieldname:string);
Function IsINIFile(fieldname:string):Boolean;
procedure GetExportFields();
procedure IsCheck();
{ Private declarations }
public
ExportFields,IniName:string;
{ Public declarations }
end;
var
frmSelExportField: TfrmSelExportField;
implementation
uses U_Fun;
{$R *.dfm}
procedure TfrmSelExportField.CreateCheckBox();
var
i,j,FTop,FLeft,Fdiv,FMod,z:Integer;// mod 余数，div商
FCheckBox:TCheckBox;
begin
z:=0;
for i:=0 to ExpGrid.ColumnCount-1 do
begin
if ExpGrid.Columns[i].Visible=True then
begin
Fdiv:=(z+1) div 3;
FMod:=(z+1) mod 3;
FCheckBox:=TCheckBox.Create(Self);
FCheckBox.Caption:=Trim(ExpGrid.Columns[i].Caption);
FCheckBox.Tag:=i;
FCheckBox.Parent:=Panel2;
FCheckBox.Checked:=True;
if FMod>0 then
FCheckBox.Top:=36*(Fdiv+1)
else
FCheckBox.Top:=36*Fdiv;
if FMod=1 then
FCheckBox.Left:=29
else if FMod=2 then
FCheckBox.Left:=163
else if FMod=0 then
FCheckBox.Left:=305;
z:=z+1;
end;
end;
end;
procedure TfrmSelExportField.Button1Click(Sender: TObject);
begin
//ShowMessage('10除以3取余'+inttostr(10 mod 3)+',取整'+inttostr(10 div 3));
ExportData();
GetExportFields();
if IsINIFile(IniName)=True then
begin
DeleteFile(IniName);
end;
WriteINIFile(IniName);
end;
procedure TfrmSelExportField.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure TfrmSelExportField.FormDestroy(Sender: TObject);
begin
frmSelExportField:=nil;
end;
procedure TfrmSelExportField.FormShow(Sender: TObject);
begin
CreateCheckBox();
ReadINIFile(IniName);
IsCheck();
end;
procedure TfrmSelExportField.IsCheck();
var
i:Integer;
fsj:string;
begin
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
fsj:=Trim(TCheckBox(Controls[i]).Caption);
if Pos(fsj,ExportFields)>0 then
TCheckBox(Controls[i]).Checked:=True
else
TCheckBox(Controls[i]).Checked:=False;
end;
end;
end;
end;
procedure TfrmSelExportField.ExportData();
var
i,j:Integer;
begin
j:=0;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked=True then
begin
j:=1;
ExpGrid.Columns[TCheckBox(Controls[i]).Tag].Visible:=True
end else
begin
ExpGrid.Columns[TCheckBox(Controls[i]).Tag].Visible:=False;
end;
end;
end;
end;
TcxGridToExcel(Trim(IniName),cxGrid1);
end;
procedure TfrmSelExportField.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TfrmSelExportField.ReadINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldExportSet\' +trim(fieldname)+'.INI';
programIni:=Tinifile.create(FName);
ExportFields:=programIni.ReadString('导出设置','导出字段','');
programIni.Free;
end;
procedure TfrmSelExportField.GetExportFields();
var
i:Integer;
begin
ExportFields:='Begin';
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if TCheckBox(Controls[i]).Checked then
begin
ExportFields:=ExportFields+'/'+TCheckBox(Controls[i]).Caption;
end;
end;
end;
end;
end;
//////////////////////////////////////////////////////////////////
//写设置信息到INI文件
//参数
//////////////////////////////////////////////////////////////////
procedure TfrmSelExportField.WriteINIFile(fieldname:string);
var
programIni:Tinifile; //配置文件名
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldExportSet\'+trim(fieldname)+'.INI';
if not DirectoryExists(ExtractFileDir(FName)) then
CreateDir(ExtractFileDir(FName));
programIni:=Tinifile.create(FName);
programIni.WriteString('导出设置','导出字段',ExportFields);
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//判断InI文件是否存在
//////////////////////////////////////////////////////////////////
Function TfrmSelExportField.IsINIFile(fieldname:string):Boolean;
var
FName:string;
begin
FName:=ExtractFilePath(Application.ExeName)+'FieldExportSet\'+trim(fieldname)+'.INI';
if FileExists(FName) then
Result:=True
else
Result:=false;
end;
procedure TfrmSelExportField.CheckBox1Click(Sender: TObject);
var
i:Integer;
begin
if CheckBox1.Checked then
begin
CheckBox2.Checked:=False;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if (TCheckBox(Controls[i]).Name<>'CheckBox1') and (TCheckBox(Controls[i]).Name<>'CheckBox2') then
begin
TCheckBox(Controls[i]).Checked:=True;
end;
end;
end;
end;
end;
end;
procedure TfrmSelExportField.CheckBox2Click(Sender: TObject);
var
i:Integer;
begin
if CheckBox2.Checked then
begin
CheckBox1.Checked:=False;
with Panel2 do
begin
for i:=0 to Panel2.ControlCount-1 do
begin
if Controls[i] is TCheckBox then
begin
if (TCheckBox(Controls[i]).Name<>'CheckBox1') and (TCheckBox(Controls[i]).Name<>'CheckBox2') then
begin
TCheckBox(Controls[i]).Checked:=False;
end;
end;
end;
end;
end;
end;
end.

30
Z99Dependency/ThreeFun/Fun/U_getDogServer.pas Normal file
View File

@ -0,0 +1,30 @@
unit U_getDogServer;
interface
uses
SysUtils,Windows,IniFiles,StrUtils;
function GetLink(H: THandle;var ADOConnString:PAnsiChar):Integer;stdcall; external 'PUBLICDLL.DLL';
function GetLinkDog(H: THandle;var ADOConnString:string):Integer;
implementation
function GetLinkDog(H: THandle;var ADOConnString:string):Integer;
var
str1:string;
Pstr1: PChar;
begin
try
SetLength(str1,255);
pstr1:=pchar(str1);
result:= GetLink(H,pstr1);
ADOConnString:=trim(pstr1);
finally
SetLength(str1,0);
end;
end;
end.

7502
Z99Dependency/ThreeFun/Fun/superobject.pas Normal file
View File

File diff suppressed because it is too large Load Diff

23
发货申请(ShipmentRequest.dll)/ProjectGroup1.~bpg
View File

@ -1,23 +0,0 @@
#------------------------------------------------------------------------------
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)

23
坯布仓库(GreyClothWarehouse.dll)/ProjectGroup1.~bpg
View File

@ -1,23 +0,0 @@
#------------------------------------------------------------------------------
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)

BIN
坯布仓库(GreyClothWarehouse.dll)/wav.zip
View File

Binary file not shown.

23
应收应付2/ProjectGroup1.~bpg
View File

@ -1,23 +0,0 @@
#------------------------------------------------------------------------------
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)

BIN
应收应付2/YSYF.rar
View File

Binary file not shown.

BIN
应收应付2/YSYF.zip
View File

Binary file not shown.

BIN
样品(YPGL.dll)/YPGL.rar
View File

Binary file not shown.

23
进度统计查询(Statistics.dll)/ProjectGroup1.~bpg
View File

@ -1,23 +0,0 @@
#------------------------------------------------------------------------------
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)