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

12345

Browse Source
This commit is contained in:
DESKTOP-E401PHE\Administrator 2025-11-14 15:11:06 +08:00
commit d01e515feb
790 changed files with 480820 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
.gitignore vendored Normal file
View File

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

191
A00通用窗体/U_AttachmentUpload.dfm Normal file
View File

@ -0,0 +1,191 @@
inherited frmAttachmentUpload: TfrmAttachmentUpload
Left = 192
Top = 134
BorderIcons = [biSystemMenu, biMinimize]
Caption = #38468#20214#20449#24687
ClientHeight = 463
ClientWidth = 851
Font.Charset = GB2312_CHARSET
Font.Height = -13
Font.Name = #23435#20307
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 867
ExplicitHeight = 502
PixelsPerInch = 107
TextHeight = 13
object ListView1: TListView [0]
Left = 43
Top = 22
Width = 465
Height = 83
Columns = <>
TabOrder = 0
OnDblClick = ListView1DblClick
end
object Panel1: TPanel [1]
Left = 687
Top = 0
Width = 164
Height = 463
Align = alRight
TabOrder = 1
object FileName: TcxButton
Left = 33
Top = 63
Width = 81
Height = 27
Hint = 'Filesother'
Caption = #28155#21152
LookAndFeel.Kind = lfOffice11
TabOrder = 0
OnClick = FileNameClick
end
object cxButton1: TcxButton
Left = 33
Top = 104
Width = 81
Height = 27
Hint = 'Filesother'
Caption = #21024#38500
LookAndFeel.Kind = lfOffice11
TabOrder = 1
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 33
Top = 143
Width = 81
Height = 27
Hint = 'Filesother'
Caption = #19979#36733
LookAndFeel.Kind = lfOffice11
TabOrder = 2
OnClick = cxButton2Click
end
object cxButton3: TcxButton
Left = 33
Top = 186
Width = 81
Height = 27
Hint = 'Filesother'
Caption = #20851#38381
LookAndFeel.Kind = lfOffice11
TabOrder = 3
Visible = False
OnClick = cxButton3Click
end
end
object Panel2: TPanel [2]
Left = 191
Top = 152
Width = 209
Height = 44
BevelInner = bvRaised
BevelOuter = bvLowered
Caption = 'Panel2'
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -13
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
Visible = False
OnDblClick = Panel2DblClick
end
object cxGrid1: TcxGrid [3]
Left = 0
Top = 0
Width = 687
Height = 463
Align = alClient
TabOrder = 3
object Tv1: TcxGridDBTableView
OnDblClick = Tv1DblClick
Navigator.Buttons.CustomButtons = <>
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.Editing = False
OptionsView.GroupByBox = False
OptionsView.Indicator = True
object v1Column1: TcxGridDBColumn
Caption = #25991#20214#21517#31216
DataBinding.FieldName = 'FileName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 146
end
object v1Column4: TcxGridDBColumn
Caption = #25991#20214#20462#25913#26102#38388
DataBinding.FieldName = 'TFdate'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 140
end
object v1Column2: TcxGridDBColumn
Caption = #25805#20316#21592
DataBinding.FieldName = 'Filler'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 83
end
object v1Column3: TcxGridDBColumn
Caption = #19978#20256#26102#38388
DataBinding.FieldName = 'FillTime'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 140
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
inherited ADOQueryBaseCmd: TADOQuery
Left = 113
Top = 64
end
object ADOQueryTmp: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 323
Top = 149
end
object ADOQueryCmd: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 624
Top = 96
end
object ImageList1: TImageList
Left = 536
Top = 228
end
object IdFTP1: TIdFTP
ConnectTimeout = 0
NATKeepAlive.UseKeepAlive = False
NATKeepAlive.IdleTimeMS = 0
NATKeepAlive.IntervalMS = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
ReadTimeout = 0
Left = 492
Top = 198
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 380
Top = 272
end
object DataSource1: TDataSource
DataSet = ADOQueryTmp
Left = 548
Top = 140
end
end

381
A00通用窗体/U_AttachmentUpload.pas Normal file
View File

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

4615
A00通用窗体/U_BankSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

181
A00通用窗体/U_BankSel.pas Normal file
View File

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

4851
A00通用窗体/U_ClothInfoSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

313
A00通用窗体/U_ClothInfoSel.pas Normal file
View File

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

4803
A00通用窗体/U_ClothPurchasePlanSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

246
A00通用窗体/U_ClothPurchasePlanSel.pas Normal file
View File

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

4567
A00通用窗体/U_CompanySel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

186
A00通用窗体/U_CompanySel.pas Normal file
View File

@ -0,0 +1,186 @@
unit U_CompanySel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput,
dxScrollbarAnnotations;
type
TfrmCompanySel = class(TfrmBaseHelp)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
CoName: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
TV1Column1: TcxGridDBColumn;
TV1Column2: TcxGridDBColumn;
TV1Column3: TcxGridDBColumn;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNameChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoType, FAuthority: string;
{ Public declarations }
end;
var
frmCompanySel: TfrmCompanySel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmCompanySel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败！', '提示信息');
end;
end;
procedure TfrmCompanySel.CoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmCompanySel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CoName.SetFocus;
Action := cahide;
end;
procedure TfrmCompanySel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.* from BS_Company A where 1=1 and valid=''Y'' ');
if Trim(FCoType) <> '' then
begin
sql.Add(' and A.CoType=''' + Trim(FCoType) + '''');
end;
if Trim(FAuthority) = '理单业务' then
begin
SQL.Add('and ( filler=' + quotedstr(trim(dname)));
sql.Add('or SalesId=' + quotedstr(trim(DCode)) + ' or exists (select * from [dbo].[F_Tool_SplitString](TallyId,'','') X where X.RTValue =' + quotedstr(trim(DCode)) + '))');
end;
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCompanySel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmCompanySel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmCompanySel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmCompanySel.ToolButton1Click(Sender: TObject);
begin
CoName.SetFocus;
ModalResult := 1;
end;
procedure TfrmCompanySel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmCompanySel.FormDestroy(Sender: TObject);
begin
inherited;
frmCompanySel := nil;
end;
end.

937
A00通用窗体/U_EmployeeSel.dfm Normal file
View File

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

218
A00通用窗体/U_EmployeeSel.pas Normal file
View File

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

4823
A00通用窗体/U_KnitClothInfoSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

293
A00通用窗体/U_KnitClothInfoSel.pas Normal file
View File

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

4078
A00通用窗体/U_LabelMapSet.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

353
A00通用窗体/U_LabelMapSet.pas Normal file
View File

@ -0,0 +1,353 @@
unit U_LabelMapSet;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxPC, cxCheckComboBox, cxDropDownEdit, Menus, RM_e_Xls,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxSkinsCore,
dxSkinsDefaultPainters, dxDateRanges, dxBarBuiltInMenu, System.ImageList,
Vcl.ImgList, U_BaseHelp, dxScrollbarAnnotations;
type
TfrmLabelMapSet = class(Tform)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
Panel1: TPanel;
LMName: TEdit;
v2Column8: TcxGridDBColumn;
Label1: TLabel;
v2Column12: TcxGridDBColumn;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
Label2: TLabel;
LMType: TEdit;
v2Column1: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
ToolButton1: TToolButton;
Tv1Column2: TcxGridDBColumn;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
cxGridLevel2: TcxGridLevel;
DS_2: TDataSource;
ToolBar2: TToolBar;
ToolButton12: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton3: TToolButton;
ADO_2: TADOQuery;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure CustomerChange(Sender: TObject);
procedure v2Column8PropertiesEditValueChanged(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
procedure Getfields(MSql: Integer);
public
IsSql1: Boolean;
FLMType: string;
FFiltration1, FFiltration2, FFiltration3: string;
{ Public declarations }
end;
var
frmLabelMapSet: TfrmLabelMapSet;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp;
{$R *.dfm}
procedure TfrmLabelMapSet.Getfields(MSql: Integer);
begin
case MSql of
1:
begin
if IsSql1 then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql1').AsString));
sql.add(FFiltration1);
Open;
end;
end
else
begin
if trim(CDS_1.fieldbyname('LMSql1').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql1').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration1)));
Open;
end;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
2:
begin
if trim(CDS_1.fieldbyname('LMSql2').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql2').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration2)));
Open;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(False); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
3:
begin
if trim(CDS_1.fieldbyname('LMSql3').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql3').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration3)));
Open;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
end;
end;
procedure TfrmLabelMapSet.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
SQL.Clear;
sql.Add(' select A.* from BS_Label_Map A ');
sql.Add(' where LMType=' + quotedstr(FLMType));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
ToolButton2.Click;
end;
end;
procedure TfrmLabelMapSet.FormDestroy(Sender: TObject);
begin
frmLabelMapSet := nil;
end;
procedure TfrmLabelMapSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmLabelMapSet.FormCreate(Sender: TObject);
begin
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
// ADOQueryBaseCmd.Connection := ADOConnection1;
// ADOQueryBaseTemp.Connection := ADOConnection1;
except
end;
end;
procedure TfrmLabelMapSet.TBCloseClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelMapSet.FormShow(Sender: TObject);
begin
ReadCxGrid(Trim(Self.Caption), Tv1, '标签管理');
InitGrid();
end;
procedure TfrmLabelMapSet.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmLabelMapSet.ToolButton12Click(Sender: TObject);
begin
Getfields(1);
end;
procedure TfrmLabelMapSet.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(Trim(Self.Caption), Tv1, '标签管理');
end;
procedure TfrmLabelMapSet.ToolButton2Click(Sender: TObject);
var
sql: string;
begin
if ADOQueryMain.Active then
begin
sql := SGetFilters(Panel1, 1, 2);
SDofilter(ADOQueryMain, sql);
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmLabelMapSet.ToolButton3Click(Sender: TObject);
begin
TcxGridToExcel('sql字段', cxgrid2);
end;
procedure TfrmLabelMapSet.cxTabControl1Change(Sender: TObject);
begin
InitGrid;
end;
procedure TfrmLabelMapSet.CustomerChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmLabelMapSet.v2Column8PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate BS_Label_Map ');
sql.Add(' Set ' + FFieldName + '=''' + Trim(mvalue) + '''');
sql.Add(' , Editer=''' + Trim(DName) + '''');
sql.Add(' , Edittime=getdate()');
sql.Add(' where LMID=' + quotedstr(CDS_1.fieldbyname('LMID').AsString));
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv1.Controller.EditingController.ShowEdit();
except
tv1.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败！', '提示', 0);
end
end;
procedure TfrmLabelMapSet.ToolButton4Click(Sender: TObject);
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into BS_Label_Map(LMType,Filler) values(' + quotedstr(Trim(FLMType)) + ',' + quotedstr(Trim(dname)) + ')');
ExecSQL;
end;
InitGrid();
end;
procedure TfrmLabelMapSet.ToolButton5Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete BS_Label_Map where LMID=' + QuotedStr(CDS_1.FieldByName('LMID').AsString));
ExecSQL;
end;
CDS_1.Delete;
end;
procedure TfrmLabelMapSet.ToolButton6Click(Sender: TObject);
begin
Getfields(2);
end;
procedure TfrmLabelMapSet.ToolButton7Click(Sender: TObject);
begin
Getfields(3);
end;
end.

4513
A00通用窗体/U_LabelPrint.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

291
A00通用窗体/U_LabelPrint.pas Normal file
View File

@ -0,0 +1,291 @@
unit U_LabelPrint;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Class, RM_GridReport, RM_Dataset, Vcl.Buttons, RM_E_llPDF, RM_BarCode,
RM_e_Graphic, RM_e_Jpeg, RM_e_Xls, cxContainer, cxMaskEdit, cxDropDownEdit,
cxMRUEdit;
type
TfrmLabelPrint = class(TfrmBaseHelp)
ADOQueryTemp: TADOQuery;
ADOConnection1: TADOConnection;
Panel1: TPanel;
ImageList1: TImageList;
RMDB_1: TRMDBDataSet;
RM1: TRMGridReport;
RMDB_2: TRMDBDataSet;
CDS_Label: TClientDataSet;
ADO_1: TADOQuery;
btnPrint: TSpeedButton;
btnShow: TSpeedButton;
ADO_2: TADOQuery;
RMDB_3: TRMDBDataSet;
ADO_3: TADOQuery;
RMXLSExport1: TRMXLSExport;
RMJPEGExport1: TRMJPEGExport;
RMBarCodeObject1: TRMBarCodeObject;
RMllPDFExport1: TRMllPDFExport;
CheckBox1: TCheckBox;
ComboBox1: TComboBox;
Label1: TLabel;
cbbLab: TcxMRUEdit;
CheckBox2: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure btnShowClick(Sender: TObject);
procedure cbbLabPropertiesButtonClick(Sender: TObject);
private
procedure InitGrid();
procedure PrintLabel(MIsShow: Boolean);
{ Private declarations }
public
FPreviewPrint, IsSql1: Boolean;
FLMType: string; //标签类型
FFiltration1, FFiltration2, FFiltration3: string;
{ Public declarations }
end;
var
frmLabelPrint: TfrmLabelPrint;
implementation
uses
U_DataLink, U_RTFun, U_LabelMapSet;
{$R *.dfm}
procedure TfrmLabelPrint.PrintLabel(MIsShow: Boolean);
var
fPrintFile, fPrintFile10, FMainID, LBName: string;
begin
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
RMllPDFExport1.ShowDialog := CheckBox2.Checked;
RMJPEGExport1.ShowDialog := CheckBox2.Checked;
RMXLSExport1.ShowDialog := CheckBox2.Checked;
RM1.ShowPrintDialog := CheckBox1.Checked;
LBName := cbbLab.text;
ExportFtErpFile(LBName + '.rmf', ADOQueryTemp);
if CDS_Label.Locate('LMName', LBName, []) then
begin
if IsSql1 then
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql1').AsString));
sql.add(FFiltration1);
Open;
end;
end
else
begin
if trim(CDS_Label.fieldbyname('LMSql1').AsString) <> '' then
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql1').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration1)));
Open;
end;
end;
if trim(CDS_Label.fieldbyname('LMSql2').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql2').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration2)));
Open;
end;
end;
if trim(CDS_Label.fieldbyname('LMSql3').AsString) <> '' then
begin
with ADO_3 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql3').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration3)));
Open;
end;
end;
end;
end;
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf';
if FileExists(fPrintFile) then
begin
RM1.LoadFromFile(fPrintFile);
RM1.DefaultCopies := StrToIntDef(ComboBox1.Text, 1);
if MIsShow then
RM1.ShowReport
else
RM1.PrintReport;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
end;
end;
procedure TfrmLabelPrint.FormCreate(Sender: TObject);
begin
inherited;
FPreviewPrint := True;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
end;
end;
procedure TfrmLabelPrint.btnPrintClick(Sender: TObject);
begin
PrintLabel(False);
ModalResult := 1;
end;
procedure TfrmLabelPrint.btnShowClick(Sender: TObject);
begin
PrintLabel(true);
end;
procedure TfrmLabelPrint.cbbLabPropertiesButtonClick(Sender: TObject);
begin
try
frmLabelMapSet := TfrmLabelMapSet.Create(Application);
with frmLabelMapSet do
begin
IsSql1 := self.IsSql1;
FFiltration1 := self.FFiltration1;
FFiltration2 := self.FFiltration2;
FFiltration3 := self.FFiltration3;
FLMType := self.FLMType;
if ShowModal = 1 then
begin
Self.InitGrid();
end;
end;
finally
frmLabelMapSet.Free;
end;
end;
procedure TfrmLabelPrint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cahide;
end;
procedure TfrmLabelPrint.InitGrid();
begin
with ADOQueryTemp do
begin
close;
sql.Clear;
sql.Add('select distinct(LMName) name from BS_Label_Map where LMType=' + QuotedStr(TRIM(FLMType)));
Open;
if isEmpty then
begin
exit;
end;
cbbLab.Properties.LookupItems.Clear;
while not Eof do
begin
cbbLab.Properties.LookupItems.Add(Trim(fieldByName('Name').AsString));
Next;
end;
cbbLab.ItemIndex := 0;
end;
with ADOQueryTemp do
begin
Filtered := False;
Close;
sql.Clear;
Sql.Add('select * from BS_Label_Map where LMType=' + QuotedStr(TRIM(FLMType)));
Open;
end;
SCreateCDS(ADOQueryTemp, CDS_Label);
SInitCDSData(ADOQueryTemp, CDS_Label);
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
end;
procedure TfrmLabelPrint.FormShow(Sender: TObject);
begin
inherited;
if FPreviewPrint then
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]
else
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
if Trim(FFiltration2) = '' then
FFiltration2 := FFiltration1;
if Trim(FFiltration3) = '' then
FFiltration3 := FFiltration1;
InitGrid();
end;
procedure TfrmLabelPrint.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelPrint.FormDestroy(Sender: TObject);
begin
inherited;
frmLabelPrint := nil;
end;
end.

165
A00通用窗体/U_PictureUpload.dfm Normal file
View File

@ -0,0 +1,165 @@
object frmPictureUpload: TfrmPictureUpload
Left = 697
Top = 183
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #33719#21462#22270#29255
ClientHeight = 449
ClientWidth = 496
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Image2: TImage
Left = 464
Top = 8
Width = 160
Height = 120
end
object SpeedButton3: TSpeedButton
Left = 500
Top = 426
Width = 80
Height = 22
Caption = #25918#24323
end
object ScrollBox1: TScrollBox
Left = 0
Top = 38
Width = 496
Height = 411
HorzScrollBar.Visible = False
VertScrollBar.Visible = False
Align = alClient
TabOrder = 0
ExplicitLeft = 5
ExplicitTop = 5
ExplicitWidth = 300
ExplicitHeight = 400
object Image1: TImage
Left = 0
Top = 0
Width = 492
Height = 407
Cursor = crSizeAll
Align = alClient
Center = True
IncrementalDisplay = True
Stretch = True
OnMouseDown = Image1MouseDown
OnMouseMove = Image1MouseMove
ExplicitLeft = -2
ExplicitTop = 3
ExplicitWidth = 275
ExplicitHeight = 436
end
end
object ToolBar1: TToolBar
Tag = 1
Left = 0
Top = 0
Width = 496
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 103
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Contract.ImageList_new32
Images = DataLink_Contract.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 1
ExplicitWidth = 509
object ToolButton1: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #25171#24320#22270#29255
ImageIndex = 23
OnClick = ToolButton1Click
end
object TBSave: TToolButton
Left = 95
Top = 0
AutoSize = True
Caption = #20445#23384
Enabled = False
ImageIndex = 16
OnClick = TBSaveClick
end
object ToolButton3: TToolButton
Left = 166
Top = 0
AutoSize = True
Caption = #22270#29255#21478#23384#20026
ImageIndex = 13
OnClick = ToolButton3Click
end
object ToolButton2: TToolButton
Left = 273
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 14
OnClick = ToolButton2Click
end
object ToolButton4: TToolButton
Left = 344
Top = 0
AutoSize = True
Caption = #25918#24323
ImageIndex = 10
OnClick = ToolButton4Click
end
object TBClose: TToolButton
Left = 415
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object OpenPictureDialog1: TOpenPictureDialog
Left = 112
Top = 128
end
object ADOQuery1: TADOQuery
Connection = DataLink_Contract.ADOLink
Parameters = <>
Left = 224
Top = 264
end
object SaveDialog1: TSavePictureDialog
Left = 96
Top = 235
end
object adoqueryImage: TADOQuery
Connection = DataLink_Contract.ADOLink
Parameters = <>
Left = 224
Top = 184
end
object IdFTP1: TIdFTP
ConnectTimeout = 0
NATKeepAlive.UseKeepAlive = False
NATKeepAlive.IdleTimeMS = 0
NATKeepAlive.IntervalMS = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
ReadTimeout = 0
Left = 244
Top = 118
end
end

536
A00通用窗体/U_PictureUpload.pas Normal file
View File

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

4671
A00通用窗体/U_ProductInfoSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

182
A00通用窗体/U_ProductInfoSel.pas Normal file
View File

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

4810
A00通用窗体/U_SalesContractSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

216
A00通用窗体/U_SalesContractSel.pas Normal file
View File

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

4874
A00通用窗体/U_TatClothInfoSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

320
A00通用窗体/U_TatClothInfoSel.pas Normal file
View File

@ -0,0 +1,320 @@
unit U_TatClothInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxTL,
cxMaskEdit, cxTLdxBarBuiltInMenu, cxCheckBox, cxInplaceContainer, cxDBTL,
cxTLData, math, dxScrollbarAnnotations;
type
TfrmTatClothInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DS_Tree: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
Panel3: TPanel;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SSel: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Panel7: TPanel;
Panel4: TPanel;
Label14: TLabel;
LBCPAP1: TLabel;
Button1: TButton;
Button2: TButton;
TCBNOR1: TComboBox;
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
Label9: TLabel;
Label8: TLabel;
C_Code: TEdit;
C_Name: TEdit;
C_GramWeight: TEdit;
C_Width: TEdit;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
cxGrid3: TcxGrid;
TV3: TcxGridDBTableView;
cxGridDBColumn1: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
TV3Column1: TcxGridDBColumn;
CDS_Sub: TClientDataSet;
DataSource3: TDataSource;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TCBNOR1Change(Sender: TObject);
procedure C_NameChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
private
CurrentPage, RecordsNumber: Integer;
procedure InitGrid();
procedure InitTree();
{ Private declarations }
public
FCoType: string;
{ Public declarations }
end;
var
frmTatClothInfoSel: TfrmTatClothInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmTatClothInfoSel.InitTree();
var
i: Integer;
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_Type where CTType=''梭织'' ');
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmTatClothInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
//frmZDYHelp.Free;
end;
end;
procedure TfrmTatClothInfoSel.Button1Click(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.Button2Click(Sender: TObject);
begin
if CurrentPage < CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.cxDBTreeList1DblClick(Sender: TObject);
begin
CurrentPage := 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.C_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmTatClothInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Code.SetFocus;
Action := cahide;
end;
procedure TfrmTatClothInfoSel.InitGrid();
var
fwhere, MBCIID, Pwhere: string;
begin
if not CDS_1.IsEmpty then
MBCIID := Trim(CDS_1.FieldByName('BCIID').AsString)
else
MBCIID := '';
Pwhere := SGetFilters(Panel1, 1, 2);
if trim(Pwhere) <> '' then
begin
if fwhere <> '' then
fwhere := fwhere + ' and ' + trim(Pwhere)
else
fwhere := ' where ' + trim(Pwhere);
end;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
sql.Clear;
sql.Add(' exec P_BS_CloInfo_Get ');
sql.Add(' @CTID=' + quotedstr(Trim(CDS_Tree.fieldbyname('CTID').AsString)));
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
sql.Add(',@criteria= ' + quotedstr(fwhere));
// ShowMessage(sql.Text);
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
TV1.DataController.Filter.Clear;
LBCPAP1.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber));
finally
ADOQueryMain.EnableControls;
TV1.DataController.Filter.Clear;
end;
if MBCIID <> '' then
CDS_1.Locate('BCIID', MBCIID, []);
end;
procedure TfrmTatClothInfoSel.FormShow(Sender: TObject);
begin
inherited;
RecordsNumber := 500;
CurrentPage := 1;
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
InitTree();
InitGrid();
end;
procedure TfrmTatClothInfoSel.TBCloseClick(Sender: TObject);
begin
Close;
;
end;
procedure TfrmTatClothInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmTatClothInfoSel.TCBNOR1Change(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR1.Text);
CurrentPage := 1;
C_Code.SetFocus;
InitGrid();
end;
procedure TfrmTatClothInfoSel.ToolButton1Click(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmTatClothInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmTatClothInfoSel.Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select A.* from BS_Cloth_mf A ');
sql.Add(' where A.BCIID=''' + CDS_1.FieldByName('BCIID').AsString + '''');
OPEN;
end;
SCreateCDS(ADOQueryCmd, CDS_sub);
SInitCDSData(ADOQueryCmd, CDS_sub);
end;
procedure TfrmTatClothInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmTatClothInfoSel := nil;
end;
end.

222
A00通用窗体/U_UserSel.dfm Normal file
View File

@ -0,0 +1,222 @@
inherited frmUserSel: TfrmUserSel
Left = 770
Top = 211
Caption = #29992#25143#36873#25321
ClientHeight = 522
ClientWidth = 604
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Height = -12
Font.Name = #23435#20307
OnClose = FormClose
ExplicitWidth = 620
ExplicitHeight = 561
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 604
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 75
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
OnClick = ToolButton2Click
end
object btnOK: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #30830#35748
ImageIndex = 12
OnClick = btnOKClick
end
object TBClose: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object Panel1: TPanel [1]
Left = 0
Top = 38
Width = 604
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label3: TLabel
Left = 202
Top = 13
Width = 24
Height = 12
Caption = #21517#31216
end
object Label1: TLabel
Left = 22
Top = 13
Width = 24
Height = 12
Caption = #32534#21495
end
object UserName: TEdit
Tag = 2
Left = 232
Top = 9
Width = 89
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 1
OnChange = UserNameChange
end
object UserID: TEdit
Tag = 2
Left = 52
Top = 9
Width = 89
Height = 20
ImeName = #20013#25991' - QQ'#25340#38899#36755#20837#27861
TabOrder = 0
OnChange = UserNameChange
end
end
object cxGrid1: TcxGrid [2]
Left = 0
Top = 77
Width = 604
Height = 445
Align = alClient
TabOrder = 2
object Tv1: TcxGridDBTableView
OnDblClick = Tv1DblClick
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DS_1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsView.GroupByBox = False
Styles.IncSearch = DataLink_Company.SHuangSe
Styles.Footer = DataLink_Company.handBlack
Styles.Header = DataLink_Company.handBlack
Styles.Inactive = DataLink_Company.SHuangSe
Styles.Selection = DataLink_Company.SHuangSe
object VC_SSel: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
HeaderAlignmentHorz = taCenter
Width = 48
end
object v2Column1: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'UserID'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 76
end
object v2Column2: TcxGridDBColumn
Caption = #21517#31216
DataBinding.FieldName = 'UserName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 171
end
object v2Column3: TcxGridDBColumn
Caption = #37096#38376
DataBinding.FieldName = 'Udept'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 71
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv1
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = ADOConnection1
Left = 473
Top = 184
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = ADOConnection1
Left = 465
Top = 105
end
object ADOQueryTemp: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 68
Top = 136
end
object ADOQueryCmd: TADOQuery
Connection = ADOConnection1
Parameters = <>
Left = 188
Top = 224
end
object ADOQueryMain: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 54
Top = 224
end
object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 211
Top = 124
end
object DS_1: TDataSource
DataSet = CDS_1
Left = 262
Top = 320
end
object CDS_1: TClientDataSet
Aggregates = <>
Params = <>
Left = 158
Top = 304
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 336
Top = 176
end
end

189
A00通用窗体/U_UserSel.pas Normal file
View File

@ -0,0 +1,189 @@
unit U_UserSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxDBLookupComboBox, ComObj, cxLookAndFeels, cxLookAndFeelPainters,
dxSkinsCore, dxSkinsDefaultPainters, cxNavigator, dxDateRanges, U_BaseHelp,
dxBarBuiltInMenu, System.ImageList, Vcl.ImgList;
type
FdDy = record
inc: integer; //客户端套接字句柄
FDdys: string[32]; //客户端套接字
FdDysName: string[32]; //客户端套接字
end;
TfrmUserSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
Label3: TLabel;
UserName: TEdit;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
Label1: TLabel;
UserID: TEdit;
btnOK: TToolButton;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
VC_SSel: TcxGridDBColumn;
ADOConnection1: TADOConnection;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure UserNameChange(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
public
Fdept: string;
FMultiple: Boolean;
end;
var
frmUserSel: TfrmUserSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmUserSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from SY_User where 1=1 ');
if Trim(Fdept) <> '' then
begin
sql.Add('and Udept=' + QuotedStr(Trim(Fdept)));
end;
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmUserSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败！', '提示信息');
end;
end;
procedure TfrmUserSel.FormDestroy(Sender: TObject);
begin
inherited;
frmUserSel := nil;
end;
procedure TfrmUserSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmUserSel.TBCloseClick(Sender: TObject);
begin
WriteCxGrid(trim(self.caption), Tv1, '账户选择');
Close;
end;
procedure TfrmUserSel.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid(trim(self.Caption), Tv1, '账户选择');
if FMultiple then
begin
VC_SSel.Visible := True;
VC_SSel.Hidden := False;
end
else
begin
VC_SSel.Visible := False;
VC_SSel.Hidden := True;
end;
InitGrid();
end;
procedure TfrmUserSel.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmUserSel.ToolButton2Click(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmUserSel.Tv1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmUserSel.UserNameChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmUserSel.btnOKClick(Sender: TObject);
begin
ModalResult := 1;
end;
end.

4685
A00通用窗体/U_YarnInfoSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

204
A00通用窗体/U_YarnInfoSel.pas Normal file
View File

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

4810
A00通用窗体/U_YarnPurchasePlanSel.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

247
A00通用窗体/U_YarnPurchasePlanSel.pas Normal file
View File

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

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

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

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

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

42
A01基础公司管理/Company.cfg Normal file
View File

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

138
A01基础公司管理/Company.dof Normal file
View File

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

62
A01基础公司管理/Company.dpr Normal file
View File

@ -0,0 +1,62 @@
library Company;
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
midaslib,
U_GetDllForm in 'U_GetDllForm.pas',
U_ModuleNote in 'U_ModuleNote.pas' {frmModuleNote},
U_ZDYHelpSel in 'U_ZDYHelpSel.pas' {frmZDYHelpSel},
U_iniParam in 'U_iniParam.pas',
U_BaseInput in '..\..\..\public10\design\U_BaseInput.pas' {frmBaseInput},
U_BaseList in '..\..\..\public10\design\U_BaseList.pas' {frmBaseList},
U_cxGridCustomCss in '..\..\..\public10\design\U_cxGridCustomCss.pas',
U_globalVar in '..\..\..\public10\design\U_globalVar.pas',
U_WindowFormdesign in '..\..\..\public10\design\U_WindowFormdesign.pas',
U_RTFun in '..\..\..\public10\ThreeFun\Fun\U_RTFun.pas',
U_Factory in 'U_Factory.pas' {frmFactory},
U_CustInput in 'U_CustInput.pas' {frmCustInput},
U_BaseHelp in '..\..\..\public10\design\U_BaseHelp.pas' {frmBaseHelp},
U_EmployeeList in 'U_EmployeeList.pas' {frmEmployeeList},
U_wechatSel in 'U_wechatSel.pas' {frmwechatSel},
U_ClothInfoSel in '..\A00通用窗体\U_ClothInfoSel.pas' {frmClothInfoSel},
U_CompanySel in '..\A00通用窗体\U_CompanySel.pas' {frmCompanySel},
U_AttachmentUpload in '..\A00通用窗体\U_AttachmentUpload.pas' {frmFjList_RZ},
U_CompressionFun in '..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas',
U_BankList in 'U_BankList.pas' {frmBankList},
U_LabelMapSet in '..\A00通用窗体\U_LabelMapSet.pas' {frmLabelMapSet},
U_LabelPrint in '..\A00通用窗体\U_LabelPrint.pas' {frmLabelPrint},
U_DataLink in 'U_DataLink.pas' {DataLink_Company: TDataModule},
U_UserSel in '..\A00通用窗体\U_UserSel.pas' {frmUserSel},
U_BaseDataLink in '..\..\..\public10\design\U_BaseDataLink.pas' {BaseDataLink: TDataModule},
uSZHN_JSON in '..\..\..\public10\ThreeFun\Fun\uSZHN_JSON.pas';
{$R *.res}
procedure DllEnterPoint(dwReason: DWORD); far; stdcall;
begin
DLLProc := @DLLEnterPoint;
DllEnterPoint(DLL_PROCESS_ATTACH);
end;
procedure DLLUnloadProc(Reason: Integer); register;
begin
// if (Reason = DLL_PROCESS_DETACH) or (Reason=DLL_THREAD_DETACH) then
// Application:=NewDllApp;
end;
exports
GetDllForm;
begin
try
NewDllApp := Application;
DLLProc := @DLLUnloadProc;
except
end;
end.

943
A01基础公司管理/Company.dproj Normal file
View File

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

109
A01基础公司管理/Company.dproj.local Normal file
View File

@ -0,0 +1,109 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions>
<Transaction>1899-12-30 00:00:00.000.411,D:\Dp10Repo\项目代码\RTBasics\A01基础公司管理\U_YGSel.pas=</Transaction>
<Transaction>1899-12-30 00:00:00.000.592,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LabelPrint.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.967,D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_CustInput.pas=D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_FactoryInput.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.956,=D:\Dp10Repo\项目代码\RTBasics\A01基础公司管理\U_EmployeeList.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.525,=D:\Dp10Repo\项目代码\RTBasics\A01基础公司管理\U_BankList.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.693,=D:\Dp10Repo\public10\ThreeFun\Fun\uSZHN_JSON.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.430,D:\Dp10Repo\项目代码\恒燕\A00通用窗体\U_UserSel.dfm=D:\Dp10Repo\项目代码\恒燕\A01基础公司管理\U_wechatSel.dfm</Transaction>
<Transaction>1899-12-30 00:00:00.000.311,=D:\Dp10Repo\public10\design\U_BaseDataLink.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.744,D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_Company.dfm=D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_Customer.dfm</Transaction>
<Transaction>1899-12-30 00:00:00.000.921,D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_Company.dfm=D:\Dp10Repo\项目代码\鹏华\员工管理(StaffManage.dll)\U_CompanySel.dfm</Transaction>
<Transaction>1899-12-30 00:00:00.000.033,D:\Dp10Repo\项目代码\瑜量\客户供应商管理(Company.dll)\U_ZDYHelp.pas=D:\Dp10Repo\项目代码\瑜量\客户供应商管理(Company.dll)\U_YGSel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.076,D:\Dp10Repo\项目代码\RTBasics\A01基础公司管理\U_ZdyAttachGYS.pas=</Transaction>
<Transaction>1899-12-30 00:00:00.000.967,D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_CustInput.dfm=D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_FactoryInput.dfm</Transaction>
<Transaction>1899-12-30 00:00:00.000.033,D:\Dp10Repo\项目代码\瑜量\客户供应商管理(Company.dll)\U_ZDYHelp.dfm=D:\Dp10Repo\项目代码\瑜量\客户供应商管理(Company.dll)\U_YGSel.dfm</Transaction>
<Transaction>1899-12-30 00:00:00.000.342,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_AttachmentUpload.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.435,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LabelMapSet.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.531,=D:\Dp10Repo\public10\ThreeFun\Fun\U_CompressionFun.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.744,D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_Company.pas=D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_Customer.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.294,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LbaelMapSet.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.333,=D:\Dp10Repo\public10\design\U_BaseHelp.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.368,=D:\Dp10Repo\项目代码\恒燕\A00通用窗体\U_UserSel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.430,D:\Dp10Repo\项目代码\恒燕\A00通用窗体\U_UserSel.pas=D:\Dp10Repo\项目代码\恒燕\A01基础公司管理\U_wechatSel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.921,D:\Dp10Repo\项目代码\鹏华\客户供应商管理(Company.dll)\U_Company.pas=D:\Dp10Repo\项目代码\鹏华\员工管理(StaffManage.dll)\U_CompanySel.pas</Transaction>
</Transactions>
<ProjectSortOrder AutoSort="0" SortType="0">
<File Path="android-support-v4.dex.jar"/>
<File Path="cloud-messaging.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads-base.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar"/>
<File Path="com-google-android-gms.play-services-analytics.16.0.8.dex.jar"/>
<File Path="com-google-android-gms.play-services-base.16.0.1.dex.jar"/>
<File Path="com-google-android-gms.play-services-basement.16.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-gass.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-identity.16.0.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-maps.16.1.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-stats.16.0.1.dex.jar"/>
<File Path="com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar"/>
<File Path="com-google-android-gms.play-services-tasks.16.0.1.dex.jar"/>
<File Path="com-google-android-gms.play-services-wallet.16.0.1.dex.jar"/>
<File Path="com-google-firebase.firebase-analytics.16.4.0.dex.jar"/>
<File Path="com-google-firebase.firebase-common.16.1.0.dex.jar"/>
<File Path="com-google-firebase.firebase-iid-interop.16.0.1.dex.jar"/>
<File Path="com-google-firebase.firebase-iid.17.1.1.dex.jar"/>
<File Path="com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar"/>
<File Path="com-google-firebase.firebase-messaging.17.5.0.dex.jar"/>
<File Path="fmx.dex.jar"/>
<File Path="google-play-billing.dex.jar"/>
<File Path="google-play-licensing.dex.jar"/>
<File Path="..\..\D10szXiangying"/>
<File Path="..\A00通用窗体"/>
<File Path="..\A00通用窗体\U_AttachmentUpload.pas"/>
<File Path="..\A00通用窗体\U_AttachmentUpload.dfm"/>
<File Path="..\A00通用窗体\U_ClothInfoSel.pas"/>
<File Path="..\A00通用窗体\U_ClothInfoSel.dfm"/>
<File Path="..\A00通用窗体\U_CompanySel.pas"/>
<File Path="..\A00通用窗体\U_CompanySel.dfm"/>
<File Path="..\A00通用窗体\U_LabelMapSet.pas"/>
<File Path="..\A00通用窗体\U_LabelMapSet.dfm"/>
<File Path="..\A00通用窗体\U_LabelPrint.pas"/>
<File Path="..\A00通用窗体\U_LabelPrint.dfm"/>
<File Path="..\A00通用窗体\U_UserSel.pas"/>
<File Path="..\A00通用窗体\U_UserSel.dfm"/>
<File Path="D:\Dp10Repo"/>
<File Path="..\..\..\public10"/>
<File Path="..\..\..\public10\design"/>
<File Path="..\..\..\public10\design\U_BaseHelp.pas"/>
<File Path="..\..\..\public10\design\U_BaseHelp.dfm"/>
<File Path="..\..\..\public10\design\U_BaseInput.pas"/>
<File Path="..\..\..\public10\design\U_BaseInput.dfm"/>
<File Path="..\..\..\public10\design\U_BaseList.pas"/>
<File Path="..\..\..\public10\design\U_BaseList.dfm"/>
<File Path="..\..\..\public10\design\U_cxGridCustomCss.pas"/>
<File Path="..\..\..\public10\design\U_globalVar.pas"/>
<File Path="..\..\..\public10\design\U_WindowFormdesign.pas"/>
<File Path="..\..\..\public10\design\U_BaseDataLink.pas"/>
<File Path="..\..\..\public10\design\U_BaseDataLink.dfm"/>
<File Path="..\..\..\public10\ThreeFun"/>
<File Path="..\..\..\public10\ThreeFun\Fun"/>
<File Path="..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas"/>
<File Path="..\..\..\public10\ThreeFun\Fun\U_RTFun.pas"/>
<File Path="..\..\..\public10\ThreeFun\Fun\uSZHN_JSON.pas"/>
<File Path="U_BankList.pas"/>
<File Path="U_BankList.dfm"/>
<File Path="U_CustInput.pas"/>
<File Path="U_CustInput.dfm"/>
<File Path="U_DataLink.pas"/>
<File Path="U_DataLink.dfm"/>
<File Path="U_EmployeeList.pas"/>
<File Path="U_EmployeeList.dfm"/>
<File Path="U_Factory.pas"/>
<File Path="U_Factory.dfm"/>
<File Path="U_GetDllForm.pas"/>
<File Path="U_iniParam.pas"/>
<File Path="U_ModuleNote.pas"/>
<File Path="U_ModuleNote.dfm"/>
<File Path="U_ZDYHelpSel.pas"/>
<File Path="U_ZDYHelpSel.dfm"/>
<File Path="U_wechatSel.pas"/>
<File Path="U_wechatSel.dfm"/>
</ProjectSortOrder>
</BorlandProject>

BIN
A01基础公司管理/Company.identcache Normal file
View File

Binary file not shown.

BIN
A01基础公司管理/Company.res Normal file
View File

Binary file not shown.

BIN
A01基础公司管理/Company_Icon.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 766 B

2
A01基础公司管理/Company_project.tvsconfig Normal file
View File

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

3
A01基础公司管理/Desktop.ini Normal file
View File

@ -0,0 +1,3 @@
[.ShellClassInfo]
IconFile=C:\Program Files (x86)\360\360WangPan\new_desktop_win7.ico
IconIndex=0

4
A01基础公司管理/File.INI Normal file
View File

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

7
A01基础公司管理/FileHelp.ini Normal file
View File

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

7
A01基础公司管理/JCYData.INI Normal file
View File

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

7
A01基础公司管理/JZCRS323C.INI Normal file
View File

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

0
A01基础公司管理/JZCRS323CList.txt Normal file
View File

23
A01基础公司管理/ProjectGroup1.bpg Normal file
View File

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

48
A01基础公司管理/ProjectGroup1.groupproj Normal file
View File

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

7
A01基础公司管理/ProjectGroup1.groupproj.local Normal file
View File

@ -0,0 +1,7 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions/>
<Default.Personality>
<Projects ActiveProject="D:\Dp10Repo\项目代码\D10szXiangying\A01基础公司管理\Company.dproj"/>
</Default.Personality>
</BorlandProject>

2
A01基础公司管理/ProjectGroup1_prjgroup.tvsconfig Normal file
View File

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

6
A01基础公司管理/SYSTEMSET.ini Normal file
View File

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

270
A01基础公司管理/U_BankList.dfm Normal file
View File

@ -0,0 +1,270 @@
inherited frmBankList: TfrmBankList
Left = 297
Top = 109
Caption = #38134#34892#36134#25143#31649#29702
ClientHeight = 562
ClientWidth = 1183
KeyPreview = True
ExplicitWidth = 1199
ExplicitHeight = 601
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1183
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
Color = clSkyBlue
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object ToolButton2: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
OnClick = ToolButton2Click
end
object btnok: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #36873#25321
ImageIndex = 12
OnClick = btnokClick
end
object btnadd: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #22686#34892
ImageIndex = 2
OnClick = btnaddClick
end
object btndel: TToolButton
Left = 284
Top = 0
AutoSize = True
Caption = #21024#34892
ImageIndex = 6
OnClick = btndelClick
end
object ToolButton1: TToolButton
Left = 355
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 450
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid2: TcxGrid [1]
Left = 0
Top = 81
Width = 1183
Height = 481
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 2
object Tv2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DS_1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.Footer = True
OptionsView.GroupByBox = False
Styles.Header = DataLink_Company.Default
object v2Column1: TcxGridDBColumn
Caption = #24207#21495
DataBinding.FieldName = 'SerialNo'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column1PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 50
end
object Tv2Column3: TcxGridDBColumn
Caption = #21517#31216
DataBinding.FieldName = 'BankName'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 107
end
object Tv2Column4: TcxGridDBColumn
Caption = #21345#21495
DataBinding.FieldName = 'BankCardNo'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 150
end
object Tv2Column1: TcxGridDBColumn
Caption = #24065#31181
DataBinding.FieldName = 'Currency'
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
'CNY'
'USD'
'EUR')
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 85
end
object Tv2Column5: TcxGridDBColumn
Caption = #24320#25143#34892
DataBinding.FieldName = 'BankDeposit'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 112
end
object Tv2Column6: TcxGridDBColumn
Caption = #34892#21495
DataBinding.FieldName = 'BankNo'
PropertiesClassName = 'TcxTextEditProperties'
Properties.OnEditValueChanged = v2Column8PropertiesEditValueChanged
HeaderAlignmentHorz = taCenter
Width = 133
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv2
end
end
object Panel1: TPanel [2]
Left = 0
Top = 38
Width = 1183
Height = 43
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Label1: TLabel
Left = 66
Top = 15
Width = 24
Height = 12
Caption = #21517#31216
end
object BKName: TEdit
Tag = 2
Left = 96
Top = 11
Width = 89
Height = 20
TabOrder = 0
OnChange = CustomerChange
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 233
Top = 208
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 81
Top = 209
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 347
Top = 385
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 245
Top = 385
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 149
Top = 385
end
object GPM_1: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 552
Top = 224
end
object DS_1: TDataSource
DataSet = CDS_1
Left = 467
Top = 211
end
object CDS_1: TClientDataSet
Aggregates = <>
Params = <>
Left = 360
Top = 208
end
object PopupMenu1: TPopupMenu
Left = 512
Top = 424
object N1: TMenuItem
Caption = #20840#36873
OnClick = N1Click
end
object N2: TMenuItem
Caption = #20840#24323
OnClick = N2Click
end
end
end

322
A01基础公司管理/U_BankList.pas Normal file
View File

@ -0,0 +1,322 @@
unit U_BankList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxPC, cxCheckComboBox, cxDropDownEdit, Menus, RM_e_Xls,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxSkinsCore,
dxSkinsDefaultPainters, dxDateRanges, dxBarBuiltInMenu, U_BaseList;
type
TfrmBankList = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
GPM_1: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Panel1: TPanel;
BKName: TEdit;
Label1: TLabel;
btnadd: TToolButton;
btndel: TToolButton;
v2Column1: TcxGridDBColumn;
btnok: TToolButton;
Tv2Column1: TcxGridDBColumn;
Tv2Column3: TcxGridDBColumn;
Tv2Column4: TcxGridDBColumn;
Tv2Column5: TcxGridDBColumn;
Tv2Column6: TcxGridDBColumn;
ToolButton1: TToolButton;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure CustomerChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure v2Column8PropertiesEditValueChanged(Sender: TObject);
procedure btnaddClick(Sender: TObject);
procedure btndelClick(Sender: TObject);
procedure btnokClick(Sender: TObject);
procedure v2Column1PropertiesEditValueChanged(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
public
fFlag: integer;
{ Public declarations }
RKFlag, FCYID, fmanage: string;
end;
var
frmBankList: TfrmBankList;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp;
{$R *.dfm}
procedure TfrmBankList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
SQL.Clear;
sql.Add(' select * from BS_Bank order by SerialNo ');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
ToolButton2.Click;
end;
end;
procedure TfrmBankList.FormDestroy(Sender: TObject);
begin
inherited;
frmBankList := nil;
end;
procedure TfrmBankList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmBankList.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmBankList.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid(Trim(Self.Caption), Tv2, '财务管理');
InitGrid();
end;
procedure TfrmBankList.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmBankList.btnokClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
ModalResult := 1;
end;
procedure TfrmBankList.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(Trim(Self.Caption), Tv2, '财务管理');
end;
procedure TfrmBankList.ToolButton2Click(Sender: TObject);
var
sql: string;
begin
if ADOQueryMain.Active then
begin
sql := SGetFilters(Panel1, 1, 2);
SDofilter(ADOQueryMain, sql);
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmBankList.cxTabControl1Change(Sender: TObject);
begin
InitGrid;
end;
procedure TfrmBankList.N1Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
with CDS_1 do
begin
DisableControls;
first;
while not eof do
begin
edit;
fieldbyname('ssel').Value := true;
post;
next;
end;
First;
EnableControls;
end;
end;
procedure TfrmBankList.N2Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
with CDS_1 do
begin
DisableControls;
first;
while not eof do
begin
edit;
fieldbyname('ssel').Value := false;
post;
next;
end;
First;
EnableControls;
end;
end;
procedure TfrmBankList.CustomerChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmBankList.FormCreate(Sender: TObject);
begin
inherited;
fmanage := Trim(DParameters1);
end;
procedure TfrmBankList.v2Column1PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv2.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate BS_Bank ');
sql.Add(' Set ' + FFieldName + '=' + Trim(mvalue));
sql.Add(' , Editer=''' + Trim(DName) + '''');
sql.Add(' , Edittime=getdate()');
sql.Add(' where BKID=' + quotedstr(CDS_1.fieldbyname('BKID').AsString));
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv2.Controller.EditingController.ShowEdit();
except
tv2.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败！', '提示', 0);
end
end;
procedure TfrmBankList.v2Column8PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv2.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate BS_Bank ');
sql.Add(' Set ' + FFieldName + '=''' + Trim(mvalue) + '''');
sql.Add(' , Editer=''' + Trim(DName) + '''');
sql.Add(' , Edittime=getdate()');
sql.Add(' where BKID=' + quotedstr(CDS_1.fieldbyname('BKID').AsString));
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv2.Controller.EditingController.ShowEdit();
except
tv2.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败！', '提示', 0);
end
end;
procedure TfrmBankList.btnaddClick(Sender: TObject);
var
maxId: string;
begin
BKName.SetFocus;
if GetLSNo(ADOQueryCmd, maxId, 'BK', 'BS_Bank', 4, 0) = False then
begin
Application.MessageBox('取最大号失败！', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into BS_Bank(BKID,Filler) values(' + quotedstr(Trim(maxId)) + ',' + quotedstr(Trim(dname)) + ')');
ExecSQL;
end;
InitGrid();
end;
procedure TfrmBankList.btndelClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete BS_Bank where BKID=' + QuotedStr(CDS_1.FieldByName('BKID').AsString));
ExecSQL;
end;
CDS_1.Delete;
end;
end.

245
A01基础公司管理/U_Company.dfm Normal file
View File

@ -0,0 +1,245 @@
inherited frmCompany: TfrmCompany
Left = 347
Top = 169
Caption = #20844#21496#31649#29702
ClientHeight = 611
ClientWidth = 1366
FormStyle = fsMDIChild
Position = poScreenCenter
Visible = True
ExplicitWidth = 1382
ExplicitHeight = 650
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1366
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Company.ImageList_new32
GradientEndColor = 15717318
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object btnFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
OnClick = btnFindClick
end
object btnAdd: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #26032#22686
ImageIndex = 9
OnClick = btnAddClick
end
object btnEdit: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20462#25913
ImageIndex = 3
OnClick = btnEditClick
end
object TBDel: TToolButton
Left = 284
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 5
OnClick = TBDelClick
end
object ToolButton5: TToolButton
Left = 355
Top = 0
AutoSize = True
Caption = #38468#20214
ImageIndex = 22
OnClick = ToolButton5Click
end
object ToolButton2: TToolButton
Left = 426
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 521
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid1: TcxGrid [1]
Left = 0
Top = 77
Width = 1366
Height = 534
Align = alClient
TabOrder = 1
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DS_1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsSelection.CellSelect = False
OptionsView.GroupByBox = False
Styles.IncSearch = DataLink_Company.SHuangSe
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
Styles.Inactive = DataLink_Company.SHuangSe
Styles.Selection = DataLink_Company.SHuangSe
object v2Column2: TcxGridDBColumn
Caption = #20844#21496#32534#21495
DataBinding.FieldName = 'CoCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Width = 86
end
object v2Column6: TcxGridDBColumn
Caption = #20844#21496#21517#31216
DataBinding.FieldName = 'CoName'
HeaderAlignmentHorz = taCenter
Options.Focusing = False
Width = 127
end
object Tv1Column1: TcxGridDBColumn
Caption = #20844#21496#31616#31216
DataBinding.FieldName = 'CoAbbrName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 151
end
object v2Column10: TcxGridDBColumn
Caption = #20844#21496#22320#22336
DataBinding.FieldName = 'CoAddress'
HeaderAlignmentHorz = taCenter
Width = 173
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv1
end
end
object Panel1: TPanel [2]
Left = 0
Top = 38
Width = 1366
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clWhite
ParentBackground = False
TabOrder = 2
object Label3: TLabel
Left = 202
Top = 13
Width = 48
Height = 12
Caption = #20844#21496#21517#31216
end
object Label1: TLabel
Left = 22
Top = 13
Width = 48
Height = 12
Caption = #20844#21496#32534#21495
end
object CoName: TEdit
Tag = 2
Left = 266
Top = 9
Width = 89
Height = 20
TabOrder = 1
end
object CoCode: TEdit
Tag = 2
Left = 85
Top = 9
Width = 89
Height = 20
TabOrder = 0
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 337
Top = 152
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 201
Top = 145
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 613
Top = 177
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 709
Top = 185
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 533
Top = 137
end
object GPM_1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 312
Top = 296
end
object DS_1: TDataSource
DataSet = CDS_1
Left = 499
Top = 283
end
object CDS_1: TClientDataSet
Aggregates = <>
Params = <>
Left = 424
Top = 264
end
end

231
A01基础公司管理/U_Company.pas Normal file
View File

@ -0,0 +1,231 @@
unit U_Company;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxDBLookupComboBox, ComObj, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator, U_BaseList, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges,
dxBarBuiltInMenu;
type
TfrmCompany = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
GPM_1: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
btnAdd: TToolButton;
v2Column6: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column10: TcxGridDBColumn;
btnEdit: TToolButton;
Tv1Column1: TcxGridDBColumn;
Panel1: TPanel;
Label3: TLabel;
Label1: TLabel;
CoName: TEdit;
CoCode: TEdit;
btnFind: TToolButton;
ToolButton2: TToolButton;
ToolButton5: TToolButton;
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 btnEditClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure btnFindClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
private
fFlileFlag: string;
{ Private declarations }
procedure InitGrid();
public
FAuthority: string;
end;
var
frmCompany: TfrmCompany;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp, U_CustomerInput, U_AttachmentUpload;
{$R *.dfm}
procedure TfrmCompany.InitGrid();
var
FCoCode: string;
begin
if not CDS_1.IsEmpty then
FCoCode := CDS_1.FieldByName('CoCode').AsString;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company where CoType=''我司'' and Valid=''Y'' ');
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
CDS_1.Locate('CoCode', FCoCode, []);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCompany.FormDestroy(Sender: TObject);
begin
inherited;
// frmCustomer:=nil;
end;
procedure TfrmCompany.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmCompany.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmCompany.TBDelClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('exec P_BS_Com_Del @COID=' + quotedstr(trim(CDS_1.fieldbyname('COID').AsString)));
sql.Add(',@DCode=' + quotedstr(trim(DCode)));
sql.Add(',@DName=' + quotedstr(trim(DName)));
ExecSQL;
end;
CDS_1.Delete;
end;
procedure TfrmCompany.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid(trim(self.Caption), Tv1, '客户管理');
InitGrid();
end;
procedure TfrmCompany.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmCompany.btnEditClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
try
frmCustomerInput := TfrmCustomerInput.Create(Application);
with frmCustomerInput do
begin
fFlileFlag := self.fFlileFlag;
FCOID := Trim(Self.CDS_1.fieldbyname('COID').AsString);
if ShowModal = 1 then
begin
TBRafresh.Click;
end;
end;
finally
frmCustomerInput.Free;
end;
end;
procedure TfrmCompany.ToolButton5Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
try
frmAttachmentUpload := TfrmAttachmentUpload.Create(Application);
with frmAttachmentUpload do
begin
// FEditAuthority := True;
if (Trim(FAuthority) = '录入') or (Trim(FAuthority) = '管理') then
FEditAuthority := True;
fkeyNO := Trim(Self.CDS_1.fieldbyname('Coid').AsString);
fType := '客户';
if ShowModal = 1 then
begin
end;
end;
finally
frmAttachmentUpload.Free;
end;
end;
procedure TfrmCompany.btnFindClick(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmCompany.ToolButton2Click(Sender: TObject);
begin
WriteCxGrid(trim(self.caption), Tv1, '客户管理');
end;
procedure TfrmCompany.btnAddClick(Sender: TObject);
begin
try
frmCustomerInput := TfrmCustomerInput.Create(Application);
with frmCustomerInput do
begin
FCOID := '';
fFlileFlag := self.fFlileFlag;
if ShowModal = 1 then
begin
InitGrid();
end;
end;
finally
frmCustomerInput.Free;
end;
end;
end.

547
A01基础公司管理/U_CustInput.dfm Normal file
View File

@ -0,0 +1,547 @@
object frmCustInput: TfrmCustInput
Left = 261
Top = 149
Caption = #23458#25143#36164#26009#24405#20837
ClientHeight = 643
ClientWidth = 922
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Tag = 1
Left = 0
Top = 0
Width = 922
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 75
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object ToolButton3: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 16
OnClick = ToolButton3Click
end
object TBClose: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object ScrollBox1: TScrollBox
Left = 0
Top = 38
Width = 922
Height = 261
Align = alTop
BevelInner = bvNone
BevelOuter = bvNone
BorderStyle = bsNone
Color = clWhite
Ctl3D = False
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -14
Font.Name = #23435#20307
Font.Style = []
ParentColor = False
ParentCtl3D = False
ParentFont = False
TabOrder = 1
object Label2: TLabel
Left = 12
Top = 35
Width = 52
Height = 12
Caption = #23458#25143#32534#21495
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label6: TLabel
Left = 236
Top = 35
Width = 52
Height = 12
Caption = #23458#25143#20840#31216
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label7: TLabel
Left = 39
Top = 165
Width = 26
Height = 12
Caption = #22791#27880
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel
Left = 462
Top = 35
Width = 52
Height = 12
Caption = #23458#25143#31616#31216
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label4: TLabel
Left = 39
Top = 94
Width = 26
Height = 12
Caption = #22320#22336
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label8: TLabel
Left = 262
Top = 61
Width = 26
Height = 12
Caption = #22269#23478
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label10: TLabel
Left = 15
Top = 61
Width = 52
Height = 12
Caption = #23458#25143#31561#32423
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 684
Top = 35
Width = 52
Height = 12
Caption = #23458#25143#31867#22411
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 462
Top = 60
Width = 52
Height = 15
Caption = #19978#32423#21333#20301
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = 'Times New Roman'
Font.Style = [fsBold]
ParentFont = False
end
object Label9: TLabel
Left = 683
Top = 61
Width = 53
Height = 12
Caption = #19994' '#21153' '#21592
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label11: TLabel
Left = 39
Top = 228
Width = 26
Height = 12
Caption = #37096#38376
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object CoName: TEdit
Tag = 2
Left = 294
Top = 31
Width = 140
Height = 20
TabOrder = 1
end
object CoNote: TMemo
Tag = 2
Left = 72
Top = 161
Width = 818
Height = 57
ScrollBars = ssVertical
TabOrder = 3
end
object CoAbbrName: TEdit
Tag = 2
Left = 520
Top = 31
Width = 140
Height = 20
TabOrder = 2
end
object CoCode: TEdit
Tag = 2
Left = 71
Top = 31
Width = 140
Height = 20
TabOrder = 0
end
object CoAddress: TMemo
Tag = 2
Left = 71
Top = 90
Width = 819
Height = 57
ScrollBars = ssVertical
TabOrder = 4
end
object CoLevel: TComboBox
Tag = 2
Left = 71
Top = 56
Width = 140
Height = 22
Style = csDropDownList
TabOrder = 5
Items.Strings = (
'A'
'B'
'C')
end
object cocountry: TBtnEditC
Tag = 2
Left = 294
Top = 57
Width = 140
Height = 20
Hint = 'CoCountry/'#22269#23478
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 6
OnBtnUpClick = cocountryBtnUpClick
OnBtnDnClick = cocountryBtnDnClick
end
object CoBusinessType: TBtnEditC
Tag = 2
Left = 742
Top = 31
Width = 140
Height = 20
Hint = 'CoBusinessType/'#23458#25143#31867#22411
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 7
OnBtnUpClick = cocountryBtnUpClick
OnBtnDnClick = cocountryBtnDnClick
end
object ParentCoName: TBtnEditC
Tag = 2
Left = 520
Top = 57
Width = 140
Height = 20
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
ReadOnly = True
TabOrder = 8
OnBtnUpClick = ParentCoNameBtnUpClick
OnBtnDnClick = cocountryBtnDnClick
end
object Saleser: TBtnEditC
Tag = 2
Left = 742
Top = 56
Width = 140
Height = 20
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 9
OnBtnUpClick = SaleserBtnUpClick
OnBtnDnClick = cocountryBtnDnClick
end
object dept: TBtnEditC
Tag = 2
Left = 71
Top = 224
Width = 140
Height = 22
Hint = 'khdept/'#37096#38376
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 10
OnBtnUpClick = cocountryBtnUpClick
OnBtnDnClick = cocountryBtnDnClick
end
end
object Panel1: TPanel
Left = 0
Top = 299
Width = 922
Height = 344
Align = alClient
Caption = 'Panel1'
TabOrder = 2
object Panel3: TPanel
Left = 1
Top = 1
Width = 920
Height = 342
Align = alClient
Caption = 'Panel1'
TabOrder = 0
object ToolBar3: TToolBar
Tag = 1
Left = 1
Top = 1
Width = 918
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object ToolButton2: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #35774#20026#40664#35748
ImageIndex = 15
OnClick = ToolButton2Click
end
object ToolButton6: TToolButton
Left = 95
Top = 0
AutoSize = True
Caption = #22686#34892
ImageIndex = 2
OnClick = ToolButton6Click
end
object ToolButton7: TToolButton
Left = 166
Top = 0
AutoSize = True
Caption = #21024#34892
ImageIndex = 6
OnClick = ToolButton7Click
end
end
object cxGrid2: TcxGrid
Left = 1
Top = 39
Width = 918
Height = 302
Align = alClient
BorderStyle = cxcbsNone
TabOrder = 1
object TV2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DSLXR
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
object cxGridDBColumn2: TcxGridDBColumn
Caption = #40664#35748
DataBinding.FieldName = 'IsDefault'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxCheckBoxProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 76
end
object cxGridDBColumn3: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'Contacts'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 77
end
object cxGridDBColumn5: TcxGridDBColumn
Caption = #32844#20301
DataBinding.FieldName = 'position'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 66
end
object cxGridDBColumn6: TcxGridDBColumn
Caption = #32852#31995#30005#35805
DataBinding.FieldName = 'Telephone'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 86
end
object cxGridDBColumn7: TcxGridDBColumn
Caption = #25163#26426#21495
DataBinding.FieldName = 'PhoneNumber'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 109
end
object cxGridDBColumn8: TcxGridDBColumn
DataBinding.FieldName = 'EMAIL'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 66
end
object TV2Column2: TcxGridDBColumn
Caption = #24494#20449#21495
DataBinding.FieldName = 'WeChat'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 66
end
end
object cxGridLevel2: TcxGridLevel
GridView = TV2
end
end
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 971
Top = 192
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 830
Top = 192
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 933
Top = 121
end
object cxGridPopupMenu2: TcxGridPopupMenu
PopupMenus = <>
Left = 294
Top = 502
end
object CDS_LXR: TClientDataSet
Aggregates = <>
Params = <>
Left = 377
Top = 503
end
object DSLXR: TDataSource
DataSet = CDS_LXR
Left = 464
Top = 511
end
end

543
A01基础公司管理/U_CustInput.pas Normal file
View File

@ -0,0 +1,543 @@
unit U_CustInput;
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, cxDropDownEdit, BtnEdit, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges,
dxBarBuiltInMenu, U_BaseList, dxScrollbarAnnotations;
type
TfrmCustInput = class(TForm)
ToolBar1: TToolBar;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
cxGridPopupMenu2: TcxGridPopupMenu;
ToolButton3: TToolButton;
CDS_LXR: TClientDataSet;
DSLXR: TDataSource;
ScrollBox1: TScrollBox;
Label2: TLabel;
Label6: TLabel;
Label7: TLabel;
CoName: TEdit;
CoNote: TMemo;
Label1: TLabel;
CoAbbrName: TEdit;
CoCode: TEdit;
Panel1: TPanel;
Label4: TLabel;
Label8: TLabel;
CoAddress: TMemo;
Panel3: TPanel;
ToolBar3: TToolBar;
ToolButton2: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
cxGridDBColumn2: TcxGridDBColumn;
cxGridDBColumn3: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
cxGridDBColumn6: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
Label10: TLabel;
CoLevel: TComboBox;
TV2Column2: TcxGridDBColumn;
cocountry: TBtnEditC;
Label3: TLabel;
CoBusinessType: TBtnEditC;
Label5: TLabel;
ParentCoName: TBtnEditC;
Label9: TLabel;
Saleser: TBtnEditC;
Label11: TLabel;
dept: TBtnEditC;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cocountryBtnDnClick(Sender: TObject);
procedure cocountryBtnUpClick(Sender: TObject);
procedure ParentCoNameBtnUpClick(Sender: TObject);
procedure SaleserBtnUpClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
function SaveData(): Boolean;
public
fkhType: string;
{ Public declarations }
FCOID: string;
end;
var
frmCustInput: TfrmCustInput;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp, U_YGSel, U_CompanySel, U_UserSel;
{$R *.dfm}
procedure TfrmCustInput.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company where CoType=''客户'' and COID=''' + Trim(FCOID) + '''');
Open;
end;
SCSHData(ADOQueryMain, ScrollBox1, 2);
ParentCoName.TxtCode := ADOQueryMain.FieldByName('ParentCoCode').AsString;
Saleser.TxtCode := ADOQueryMain.FieldByName('SalesId').AsString;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company_contact where COID=' + quotedstr(Trim(FCOID)));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_LXR);
SInitCDSData(ADOQueryMain, CDS_LXR);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCustInput.ParentCoNameBtnUpClick(Sender: TObject);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '客户';
if ShowModal = 1 then
begin
ParentCoName.Text := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
ParentCoName.TxtCode := Trim(CDS_1.fieldbyname('CoCode').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmCustInput.FormDestroy(Sender: TObject);
begin
frmCustInput := nil;
end;
procedure TfrmCustInput.cocountryBtnDnClick(Sender: TObject);
begin
TBtnEditC(Sender).Text := '';
TBtnEditC(Sender).TxtCode := '';
end;
procedure TfrmCustInput.cocountryBtnUpClick(Sender: TObject);
var
fsj: string;
FWZ: Integer;
begin
fsj := Trim(TEdit(Sender).Hint);
FWZ := Pos('/', fsj);
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := Copy(fsj, 1, FWZ - 1);
flagname := Copy(fsj, FWZ + 1, Length(fsj) - FWZ);
if ShowModal = 1 then
begin
TEdit(Sender).Text := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmCustInput.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmCustInput.TBCloseClick(Sender: TObject);
begin
WriteCxGrid(trim(self.Caption) + 'TV2', Tv2, '供应商管理');
close;
end;
procedure TfrmCustInput.FormShow(Sender: TObject);
var
i: integer;
a: string;
begin
ReadCxGrid(trim(self.Caption) + 'TV2', Tv2, '供应商管理');
InitGrid();
if trim(FCOID) = '' then
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add(' exec P_BS_Com_Get_No @Str=''K'' ');
Open;
end;
CoCode.Text := trim(ADOQueryTemp.FieldByName('NewCoCode').asstring);
end;
//已审核的也要能修改保存，不能修改主表内容，只能改下面两部分
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add(' select * from BS_Company where CoId=' + quotedstr(FCoId));
Open;
end;
if trim(ADOQueryTemp.FieldByName('Status').asstring) = '1' then
begin
ScrollBox1.Enabled := False;
end;
end;
procedure TfrmCustInput.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmCustInput.SaleserBtnUpClick(Sender: TObject);
begin
try
frmUserSel := TfrmUserSel.Create(Application);
with frmUserSel do
begin
Fdept := '业务';
if ShowModal = 1 then
begin
Saleser.TxtCode := Trim(CDS_1.fieldbyname('UserID').AsString);
Saleser.Text := Trim(CDS_1.fieldbyname('UserName').AsString);
end;
end;
finally
frmUserSel.Free;
end;
end;
function TfrmCustInput.SaveData(): Boolean;
var
MaxId, MaxSubId, FCoCode, FCCID: string;
begin
try
ADOQueryCmd.Connection.BeginTrans;
if Trim(FCOID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxId, 'CO', 'BS_Company', 4, 1) = False then
begin
Result := False;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败！', '提示', 0);
Exit;
end;
if trim(CoCode.Text) = '' then
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add(' exec P_BS_Com_Get_No @Str=''K'' ');
Open;
end;
CoCode.Text := trim(ADOQueryTemp.FieldByName('NewCoCode').asstring);
end;
end
else
begin
MaxId := Trim(FCOID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from BS_Company where COID=''' + Trim(FCOID) + '''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FCOID) = '' then
begin
Append;
FieldByName('FillId').Value := Trim(DCode);
FieldByName('Filler').Value := Trim(DName);
FieldByName('Saleser').Value := trim(DName);
FieldByName('SalesId').Value := trim(DCode);
FieldByName('Tallyer').Value := trim(DName);
FieldByName('TallyId').Value := trim(DCode);
FieldByName('status').Value := '0';
end
else
begin
Edit;
FieldByName('EditId').Value := Trim(DCode);
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('COID').Value := Trim(MaxId);
RTSetsavedata(ADOQueryCmd, 'BS_Company', ScrollBox1, 2);
FieldByName('CoType').Value := '客户';
FieldByName('ParentCoCode').Value := ParentCoName.TxtCode;
FieldByName('SalesId').Value := Saleser.TxtCode;
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoCode=' + quotedstr(trim(CoCode.Text)));
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('编号重复!', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoName=' + quotedstr(trim(CoName.Text)));
sql.Add(' and CoType=''客户'' ');
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('名称重复!', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoAbbrName=' + quotedstr(trim(CoAbbrName.Text)));
sql.Add(' and CoType=''客户'' ');
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('简称重复!', '提示', 0);
Exit;
end;
////////////// 联系人 ///////////////////
if not CDS_LXR.IsEmpty then
begin
with CDS_LXR do
begin
CDS_LXR.First;
while not Eof do
begin
FCCID := Trim(CDS_LXR.fieldbyname('CCID').AsString);
if Trim(FCCID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxSubId, 'CCS', 'BS_Company_contact', 4, 1) = False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取系人最大ID失败!', '提示', 0);
Exit;
end;
end
else
begin
MaxSubId := trim(FCCID);
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company_contact where CCID=' + quotedstr(Trim(MaxSubId)));
Open;
end;
with ADOQueryCmd do
begin
if Trim(FCCID) = '' then
begin
Append;
end
else
begin
Edit;
end;
FieldByName('CCID').Value := Trim(MaxSubId);
FieldByName('COID').Value := Trim(MaxId);
RTSetSaveDataCDS(ADOQueryCmd, Tv2, CDS_LXR, 'BS_Company_contact', 0);
Post;
end;
with CDS_LXR do
begin
Edit;
FieldByName('CCID').Value := Trim(MaxSubId);
Post;
end;
CDS_LXR.Next;
end;
end;
end;
////////////// 联系人 ///////////////////
//////////////// 更新名称 ////////////////////////
// with ADOQueryCmd do
// begin
// Close;
// sql.Clear;
// sql.Add('exec P_Com_Up_Code @COID=' + quotedstr(Trim(MaxId)));
// ExecSQL;
// end;
//////////////// 更新名称 ////////////////////////
ADOQueryCmd.Connection.CommitTrans;
FCCID := Trim(MaxSubId);
Result := True;
except
Result := false;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存异常!', '提示', 0);
end;
end;
procedure TfrmCustInput.ToolButton3Click(Sender: TObject);
begin
if Trim(CoAbbrName.Text) = '' then
begin
Application.MessageBox('简称不能为空!', '提示', 0);
Exit;
end;
if Trim(CoName.Text) = '' then
begin
Application.MessageBox('名称不能为空!', '提示', 0);
Exit;
end;
if SaveData() then
begin
Application.MessageBox('保存成功!', '提示', 0);
ModalResult := 1;
end;
end;
procedure TfrmCustInput.ToolButton6Click(Sender: TObject);
var
maxno: string;
begin
if GetLSNo(ADOQueryCmd, maxno, 'CC', 'BS_Company_contact', 4, 1) = False then
begin
Application.MessageBox('取系人最大ID失败!', '提示', 0);
Exit;
end;
if CDS_LXR.IsEmpty then
begin
with CDS_LXR do
begin
Append;
fieldbyname('CCID').Value := trim(maxno);
fieldbyname('IsDefault').Value := true;
Post;
end;
end
else
begin
with CDS_LXR do
begin
Append;
fieldbyname('CCID').Value := trim(maxno);
fieldbyname('IsDefault').Value := false;
Post;
end;
end;
end;
procedure TfrmCustInput.ToolButton7Click(Sender: TObject);
begin
if CDS_LXR.IsEmpty then
Exit;
if Trim(CDS_LXR.fieldbyname('CCID').AsString) <> '' then
begin
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete from BS_Company_contact where CCID=''' + Trim(CDS_LXR.fieldbyname('CCID').AsString) + '''');
ExecSQL;
end;
end;
CDS_LXR.Delete;
if CDS_LXR.IsEmpty = false then
begin
if CDS_LXR.Locate('IsDefault', true, []) = false then
begin
CDS_LXR.first;
CDS_LXR.edit;
CDS_LXR.FieldByName('IsDefault').value := true;
end;
end;
end;
procedure TfrmCustInput.ToolButton2Click(Sender: TObject);
var
DwFlag: string;
begin
DwFlag := trim(CDS_LXR.FieldByName('CCID').AsString);
if CDS_LXR.Locate('IsDefault', true, []) then
begin
CDS_LXR.edit;
CDS_LXR.FieldByName('IsDefault').value := false;
end;
if CDS_LXR.Locate('CCID', DwFlag, []) then
begin
CDS_LXR.edit;
CDS_LXR.FieldByName('IsDefault').value := true;
end;
end;
end.

610
A01基础公司管理/U_Customer.dfm Normal file
View File

@ -0,0 +1,610 @@
inherited frmCustomer: TfrmCustomer
Left = 347
Top = 169
Caption = #23458#25143#36164#26009#31649#29702
ClientHeight = 611
ClientWidth = 1366
FormStyle = fsMDIChild
Position = poScreenCenter
Visible = True
ExplicitLeft = -185
ExplicitWidth = 1382
ExplicitHeight = 650
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1366
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 103
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Company.ImageList_new32
GradientEndColor = 15717318
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object btnFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
OnClick = btnFindClick
end
object btnAdd: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #26032#22686
ImageIndex = 9
OnClick = btnAddClick
end
object btnEdit: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20462#25913
ImageIndex = 3
OnClick = btnEditClick
end
object TBDel: TToolButton
Left = 284
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 5
OnClick = TBDelClick
end
object btnSaleser: TToolButton
Left = 355
Top = 0
AutoSize = True
Caption = #25351#23450#19994#21153#21592
ImageIndex = 15
OnClick = btnSaleserClick
end
object btnTallyer: TToolButton
Left = 462
Top = 0
AutoSize = True
Caption = #25351#23450#29702#21333
ImageIndex = 15
OnClick = btnTallyerClick
end
object ToolButton4: TToolButton
Left = 557
Top = 0
AutoSize = True
Caption = #32465#23450#24494#20449
ImageIndex = 15
OnClick = ToolButton4Click
end
object btnChk: TToolButton
Left = 652
Top = 0
AutoSize = True
Caption = #23457#26680
ImageIndex = 12
OnClick = btnChkClick
end
object btnReChk: TToolButton
Left = 723
Top = 0
AutoSize = True
Caption = #25764#38144#23457#26680
ImageIndex = 11
OnClick = btnReChkClick
end
object ToolButton3: TToolButton
Left = 818
Top = 0
AutoSize = True
Caption = #38468#20214
ImageIndex = 22
OnClick = ToolButton3Click
end
object ToolButton2: TToolButton
Left = 889
Top = 0
AutoSize = True
Caption = #23548#20837
ImageIndex = 18
OnClick = ToolButton2Click
end
object ToolButton1: TToolButton
Left = 960
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 1055
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object Panel1: TPanel [1]
Left = 0
Top = 38
Width = 1366
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clWhite
ParentBackground = False
TabOrder = 1
ExplicitTop = 32
object Label3: TLabel
Left = 190
Top = 13
Width = 48
Height = 12
Caption = #23458#25143#20840#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 Label4: TLabel
Left = 502
Top = 13
Width = 24
Height = 12
Caption = #22269#23478
end
object Label5: TLabel
Left = 643
Top = 13
Width = 24
Height = 12
Caption = #37096#38376
end
object CoName: TEdit
Tag = 2
Left = 242
Top = 9
Width = 90
Height = 20
TabOrder = 1
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
object CoCode: TEdit
Tag = 2
Left = 73
Top = 9
Width = 90
Height = 20
TabOrder = 0
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
object Salesman: TEdit
Tag = 2
Left = 390
Top = 9
Width = 90
Height = 20
TabOrder = 2
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
object country: TEdit
Tag = 2
Left = 529
Top = 9
Width = 90
Height = 20
TabOrder = 3
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
object dept: TEdit
Tag = 2
Left = 670
Top = 9
Width = 90
Height = 20
TabOrder = 4
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
end
object cxGrid1: TcxGrid [2]
Left = 0
Top = 99
Width = 1366
Height = 309
Align = alClient
TabOrder = 2
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
ScrollbarAnnotations.CustomAnnotations = <>
OnFocusedRecordChanged = Tv1FocusedRecordChanged
DataController.DataSource = DS_1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.IncSearch = DataLink_Company.SHuangSe
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
Styles.Inactive = DataLink_Company.SHuangSe
Styles.Selection = DataLink_Company.SHuangSe
object Tv1Column1: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
HeaderAlignmentHorz = taCenter
Width = 48
end
object v2Column2: TcxGridDBColumn
Caption = #23458#25143#32534#21495
DataBinding.FieldName = 'CoCode'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 86
end
object v2Column6: TcxGridDBColumn
Caption = #23458#25143#20840#31216
DataBinding.FieldName = 'CoName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Options.Focusing = False
Width = 127
end
object v2Column15: TcxGridDBColumn
Caption = #23458#25143#31616#31216
DataBinding.FieldName = 'CoAbbrName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 100
end
object v2Column10: TcxGridDBColumn
Caption = #19994#21153#21592
DataBinding.FieldName = 'Saleser'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 84
end
object v2Column7: TcxGridDBColumn
Caption = #20844#21496#22320#22336
DataBinding.FieldName = 'CoAddress'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 80
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 163
end
object v2Column3: TcxGridDBColumn
Caption = #22269#23478
DataBinding.FieldName = 'cocountry'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 99
end
object Tv1Column2: TcxGridDBColumn
Caption = #23458#25143#31561#32423
DataBinding.FieldName = 'CoLevel'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column3: TcxGridDBColumn
Caption = #30331#35760#26102#38388
DataBinding.FieldName = 'Filltime'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column4: TcxGridDBColumn
Caption = #30331#35760#20154
DataBinding.FieldName = 'Filler'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column5: TcxGridDBColumn
Caption = #29702#21333
DataBinding.FieldName = 'Tallyer'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 99
end
object Tv1Column8: TcxGridDBColumn
Caption = #37096#38376
DataBinding.FieldName = 'dept'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 67
end
object Tv1Column7: TcxGridDBColumn
Caption = #19978#32423#21333#20301
DataBinding.FieldName = 'ParentCoName'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 86
end
object Tv1Column6: TcxGridDBColumn
Caption = #23458#25143#31867#22411
DataBinding.FieldName = 'KHType'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv1
end
end
object Panel2: TPanel [3]
Left = 0
Top = 408
Width = 1366
Height = 203
Align = alBottom
Caption = 'Panel2'
TabOrder = 3
object cxGrid2: TcxGrid
Left = 1
Top = 1
Width = 1364
Height = 201
Align = alClient
TabOrder = 0
object Tv2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
ScrollbarAnnotations.CustomAnnotations = <>
DataController.DataSource = DS_2
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.Header = DataLink_Company.Default
object v3Column3: TcxGridDBColumn
Caption = #40664#35748
DataBinding.FieldName = 'IsDefault'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxCheckBoxProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 76
end
object cxGridDBColumn1: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'Contacts'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 70
end
object cxGridDBColumn2: TcxGridDBColumn
Caption = #32844#20301
DataBinding.FieldName = 'position'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 70
end
object cxGridDBColumn4: TcxGridDBColumn
Caption = #32852#31995#30005#35805
DataBinding.FieldName = 'Telephone'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 99
end
object cxGridDBColumn5: TcxGridDBColumn
Caption = #25163#26426#21495
DataBinding.FieldName = 'PhoneNumber'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 102
end
object Tv2Column1: TcxGridDBColumn
Caption = 'EMAIL'
DataBinding.FieldName = 'Email'
DataBinding.IsNullValueType = True
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 108
end
object v3Column2: TcxGridDBColumn
Caption = #24494#20449#21495
DataBinding.FieldName = 'WeChat'
DataBinding.IsNullValueType = True
HeaderAlignmentHorz = taCenter
Width = 169
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv2
end
end
end
object cxTabControl1: TcxTabControl [4]
Left = 0
Top = 77
Width = 1366
Height = 22
Align = alTop
TabOrder = 4
Properties.CustomButtons.Buttons = <>
Properties.Style = 9
Properties.TabIndex = 0
Properties.Tabs.Strings = (
#26410#23457#26680
#24050#23457#26680
#20840#37096)
OnChange = cxTabControl1Change
ClientRectBottom = 22
ClientRectRight = 1366
ClientRectTop = 19
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 295
Top = 151
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 159
Top = 160
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 601
Top = 140
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 714
Top = 137
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 822
Top = 201
end
object GPM_1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 506
Top = 181
end
object DS_1: TDataSource
DataSet = CDS_1
Left = 393
Top = 277
end
object CDS_1: TClientDataSet
Aggregates = <>
Params = <>
Left = 522
Top = 321
end
object CDS_2: TClientDataSet
Aggregates = <>
Params = <>
Left = 384
Top = 460
end
object DS_2: TDataSource
DataSet = CDS_2
Left = 459
Top = 467
end
object OpenDialog1: TOpenDialog
Left = 411
Top = 184
end
object GPM_2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 320
Top = 456
end
object FDQuery1: TFDQuery
UpdateOptions.AssignedValues = [uvEDelete, uvEInsert, uvEUpdate]
UpdateOptions.EnableDelete = False
UpdateOptions.EnableInsert = False
UpdateOptions.EnableUpdate = False
Left = 286
Top = 273
end
end

648
A01基础公司管理/U_Customer.pas Normal file
View File

@ -0,0 +1,648 @@
unit U_Customer;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxDBLookupComboBox, ComObj, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator, U_BaseList, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges,
dxBarBuiltInMenu, cxPC, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, FireDAC.Comp.DataSet,
FireDAC.Comp.Client, dxScrollbarAnnotations;
type
TfrmCustomer = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
btnFind: TToolButton;
ADOQueryMain: TADOQuery;
Label3: TLabel;
CoName: TEdit;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
GPM_1: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
btnAdd: TToolButton;
v2Column6: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column7: TcxGridDBColumn;
Label1: TLabel;
CoCode: TEdit;
v2Column10: TcxGridDBColumn;
btnEdit: TToolButton;
Label2: TLabel;
Salesman: TEdit;
country: TEdit;
Label4: TLabel;
v2Column15: TcxGridDBColumn;
CDS_2: TClientDataSet;
DS_2: TDataSource;
btnSaleser: TToolButton;
v2Column3: TcxGridDBColumn;
OpenDialog1: TOpenDialog;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Panel2: TPanel;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
v3Column3: TcxGridDBColumn;
cxGridDBColumn1: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
Tv2Column1: TcxGridDBColumn;
v3Column2: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
cxTabControl1: TcxTabControl;
btnChk: TToolButton;
btnReChk: TToolButton;
Tv1Column1: TcxGridDBColumn;
btnTallyer: TToolButton;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
ToolButton1: TToolButton;
GPM_2: TcxGridPopupMenu;
ToolButton3: TToolButton;
Tv1Column7: TcxGridDBColumn;
FDQuery1: TFDQuery;
ToolButton2: TToolButton;
ToolButton4: TToolButton;
Label5: TLabel;
dept: TEdit;
Tv1Column8: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure btnFindClick(Sender: TObject);
procedure btnEditClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure TBuserClick(Sender: TObject);
procedure Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
procedure btnSaleserClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CoCodeKeyPress(Sender: TObject; var Key: Char);
procedure btnChkClick(Sender: TObject);
procedure btnReChkClick(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure btnTallyerClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure CoCodeChange(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
private
fFlileFlag: string;
{ Private declarations }
procedure InitGrid();
procedure SetStatus();
public
FAuthority: string;
end;
var
frmCustomer: TfrmCustomer;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp, U_CustomerInput, U_CustInput, U_UserSel,
U_AttachmentUpload, U_CustomerImport, U_wechatSel;
{$R *.dfm}
procedure TfrmCustomer.SetStatus();
begin
btnSaleser.Enabled := false; //指定
btnTallyer.Enabled := false; //指定
btnChk.Enabled := false; //审核
btnReChk.Enabled := false; //撤销
btnAdd.Enabled := false; //新增
btnEdit.Enabled := false; //修改
TBDel.Enabled := false; //删除
if Trim(FAuthority) = '管理' then
begin
btnSaleser.Enabled := true;
btnTallyer.Enabled := true;
btnAdd.Enabled := true;
case cxTabControl1.TabIndex of
0:
begin
btnEdit.Enabled := true;
TBDel.Enabled := true;
btnChk.Enabled := true;
end;
1:
begin
btnEdit.Enabled := true;
btnReChk.Enabled := true;
end;
2:
begin
end;
end;
end
else
begin
btnAdd.Enabled := true;
case cxTabControl1.TabIndex of
0:
begin
btnEdit.Enabled := true;
TBDel.Enabled := true;
end;
1:
begin
end;
2:
begin
end;
end;
end;
end;
procedure TfrmCustomer.InitGrid();
var
WSql, FCoCode: string;
begin
WSql := SGetFilters(Panel1, 1, 2);
if trim(WSql) <> '' then
begin
WSql := ' and ' + trim(WSql);
end;
if not CDS_1.IsEmpty then
FCoCode := CDS_1.FieldByName('CoCode').AsString;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company ');
sql.Add(' where 1=1 ' + (WSql));
sql.Add(' and CoType=''客户'' and Valid=''Y'' ');
if Trim(FAuthority) = '录入' then
begin
sql.Add(' and ( SalesId=' + quotedstr(trim(DCode)) + ' or exists (select * from [dbo].[F_Tool_SplitString](TallyId,'','') X where X.RTValue =' + quotedstr(trim(DCode)) + '))');
end;
case cxTabControl1.TabIndex of
0:
begin
sql.Add(' and status=''0''');
end;
1:
begin
sql.Add(' and status=''1''');
end;
end;
SQL.Add(' ORDER BY CoCode ');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
CDS_1.Locate('CoCode', FCoCode, []);
finally
ADOQueryMain.EnableControls;
end;
// with FDQuery1 do
// begin
//
// SQL.Clear;
// sql.Add(' select * from BS_Company ');
// sql.Add(' where 1=1 ' + (WSql));
// sql.Add(' and CoType=''客户'' and Valid=''Y'' ');
// open;
// end;
end;
procedure TfrmCustomer.FormDestroy(Sender: TObject);
begin
inherited;
frmCustomer := nil;
end;
procedure TfrmCustomer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmCustomer.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmCustomer.TBDelClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
if Trim(CDS_1.fieldbyname('COID').AsString) <> '' then
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('exec P_BS_Com_Del @COID=' + quotedstr(trim(CDS_1.fieldbyname('COID').AsString)));
sql.Add(',@DCode=' + quotedstr(trim(DCode)));
sql.Add(',@DName=' + quotedstr(trim(DName)));
ExecSQL;
end;
end;
CDS_1.Delete;
end;
procedure TfrmCustomer.FormShow(Sender: TObject);
begin
inherited;
fFlileFlag := UserDataFlag + 'HX';
FAuthority := self.fParameters1;
ReadCxGrid(trim(self.caption) + 'Tv1', Tv1, '客户管理');
ReadCxGrid(trim(self.caption) + 'Tv2', Tv2, '客户管理');
SetStatus();
InitGrid();
end;
procedure TfrmCustomer.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmCustomer.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(trim(self.caption) + 'Tv1', Tv1, '客户管理');
WriteCxGrid(trim(self.caption) + 'Tv2', Tv2, '客户管理');
end;
procedure TfrmCustomer.ToolButton2Click(Sender: TObject);
begin
try
frmCustomerImport := TfrmCustomerImport.Create(Application);
with frmCustomerImport do
begin
if ShowModal = 1 then
begin
self.InitGrid();
end;
end;
finally
frmCustomerImport.Free;
end;
end;
procedure TfrmCustomer.btnFindClick(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmCustomer.ToolButton3Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
try
frmAttachmentUpload := TfrmAttachmentUpload.Create(Application);
with frmAttachmentUpload do
begin
if (Trim(FAuthority) = '录入') or (Trim(FAuthority) = '管理') then
FEditAuthority := True;
fkeyNO := Trim(Self.CDS_1.fieldbyname('Coid').AsString);
fType := '客户';
if ShowModal = 1 then
begin
end;
end;
finally
frmAttachmentUpload.Free;
end;
end;
procedure TfrmCustomer.ToolButton4Click(Sender: TObject);
var
FUserId: string;
begin
if CDS_2.IsEmpty then
Exit;
FUserId := Trim(Self.CDS_2.FieldByName('CcID').AsString);
try
frmwechatSel := TfrmwechatSel.Create(Self);
with frmwechatSel do
begin
// FGsName:='SW';
if ShowModal = 1 then
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
SQL.Add(' update Bs_Company_contact set wechatid=' + QuotedStr(Trim(frmwechatSel.CDS_1.FieldByName('OPENID').AsString)));
SQL.Add(',wechat=' + QuotedStr(Trim(frmwechatSel.CDS_1.FieldByName('NICKNAME').AsString)));
SQL.Add(' where CCID=' + QuotedStr(Trim(FUserId)));
ExecSQL;
end;
Self.InitGrid();
Self.CDS_2.Locate('CCID', Trim(FUserId), []);
end;
end;
finally
frmwechatSel.Free;
end;
end;
procedure TfrmCustomer.CoCodeChange(Sender: TObject);
begin
btnFind.Click;
end;
procedure TfrmCustomer.CoCodeKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
InitGrid();
end;
end;
procedure TfrmCustomer.cxTabControl1Change(Sender: TObject);
begin
SetStatus();
TBRafresh.Click;
end;
procedure TfrmCustomer.btnEditClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
try
frmCustInput := TfrmCustInput.Create(Application);
with frmCustInput do
begin
fFlileFlag := self.fFlileFlag;
FCOID := Trim(Self.CDS_1.fieldbyname('COID').AsString);
if ShowModal = 1 then
begin
TBRafresh.Click;
end;
end;
finally
frmCustInput.Free;
end;
end;
procedure TfrmCustomer.btnTallyerClick(Sender: TObject);
var
MTallyId, MTallyer: string;
begin
MTallyId := '';
MTallyer := '';
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
try
frmUserSel := TfrmUserSel.Create(Application);
with frmUserSel do
begin
Fdept := '理单';
FMultiple := True;
if ShowModal = 1 then
begin
while frmUserSel.CDS_1.Locate('SSel', True, []) do
begin
MTallyId := MTallyId + Trim(CDS_1.FieldByName('UserID').AsString) + ',';
MTallyer := MTallyer + Trim(CDS_1.FieldByName('UserName').AsString) + ',';
frmUserSel.CDS_1.Delete;
end;
end;
end;
finally
frmUserSel.Free;
end;
if MTallyId = '' then
Exit;
MTallyId := copy(MTallyId, 1, Length(MTallyId) - 1);
MTallyer := copy(MTallyer, 1, Length(MTallyer) - 1);
while CDS_1.Locate('SSel', True, []) do
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('update BS_Company set TallyId=' + quotedstr(trim(MTallyId)));
sql.Add(' ,Tallyer=' + quotedstr(trim(MTallyer)));
sql.Add(' where COID=''' + Trim(CDS_1.fieldbyname('COID').AsString) + '''');
ExecSQL;
end;
CDS_1.Delete;
end;
InitGrid();
end;
procedure TfrmCustomer.btnChkClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
try
with CDS_1 do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('SSel').AsBoolean then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update BS_Company SET status=''1'',Chktime=getdate(),Chker=' + quotedstr(trim(DName)));
sql.Add('where CoID=' + quotedstr(trim(CDS_1.fieldbyname('CoID').AsString)));
execsql;
end;
end;
next;
end;
First;
EnableControls;
end;
application.MessageBox('审核成功！', '提示信息');
TBRafresh.Click;
except
application.MessageBox('审核失败！', '提示信息', 0);
end;
end;
procedure TfrmCustomer.btnReChkClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
try
with CDS_1 do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('SSel').AsBoolean then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update BS_Company SET status=''0'',Chktime=null,Chker=null ');
sql.Add('where CoID=' + quotedstr(trim(CDS_1.fieldbyname('CoID').AsString)));
execsql;
end;
end;
next;
end;
First;
EnableControls;
end;
application.MessageBox('撤销审核成功！', '提示信息');
TBRafresh.Click;
except
application.MessageBox('撤销审核失败！', '提示信息', 0);
end;
end;
procedure TfrmCustomer.btnAddClick(Sender: TObject);
begin
try
frmCustInput := TfrmCustInput.Create(Application);
with frmCustInput do
begin
FCOID := '';
fFlileFlag := self.fFlileFlag;
if ShowModal = 1 then
begin
InitGrid();
end;
end;
finally
frmCustInput.Free;
end;
end;
procedure TfrmCustomer.TBuserClick(Sender: TObject);
var
FuserName: string;
begin
end;
procedure TfrmCustomer.Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
begin
with ADOQueryTemp do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company_contact where COID=' + quotedstr(Trim(CDS_1.FieldByName('COID').AsString)));
Open;
end;
SCreateCDS(ADOQueryTemp, CDS_2);
SInitCDSData(ADOQueryTemp, CDS_2);
end;
procedure TfrmCustomer.btnSaleserClick(Sender: TObject);
var
MSaleser, MSalesId: string;
begin
try
frmUserSel := TfrmUserSel.Create(Application);
with frmUserSel do
begin
Fdept := '业务';
if ShowModal = 1 then
begin
MSalesId := Trim(CDS_1.fieldbyname('UserID').AsString);
MSaleser := Trim(CDS_1.fieldbyname('UserName').AsString);
end;
end;
finally
frmUserSel.Free;
end;
if MSalesId = '' then
Exit;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('update BS_Company set Saleser=' + quotedstr(trim(MSaleser)));
sql.Add(' ,SalesId=' + quotedstr(trim(MSalesId)));
sql.Add(' where COID=''' + Trim(CDS_1.fieldbyname('COID').AsString) + '''');
ExecSQL;
end;
initgrid();
end;
procedure TfrmCustomer.FormCreate(Sender: TObject);
begin
inherited;
FAuthority := trim(fParameters1);
end;
end.

240
A01基础公司管理/U_CustomerImport.dfm Normal file
View File

@ -0,0 +1,240 @@
object frmCustomerImport: TfrmCustomerImport
Left = 484
Top = 189
Caption = #23458#25143#23548#20837
ClientHeight = 504
ClientWidth = 1530
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Tag = 1
Left = 0
Top = 0
Width = 1530
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ShowCaptions = True
TabOrder = 0
object TSave: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 16
OnClick = TSaveClick
end
object ToolButton4: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #25171#24320#25991#20214
ImageIndex = 4
OnClick = ToolButton4Click
end
object ToolButton2: TToolButton
Left = 166
Top = 0
AutoSize = True
Caption = #21024#34892
ImageIndex = 6
OnClick = ToolButton2Click
end
object ToolButton3: TToolButton
Left = 237
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton3Click
end
object TBClose: TToolButton
Left = 332
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid1: TcxGrid
Left = 0
Top = 38
Width = 1530
Height = 466
Align = alClient
TabOrder = 1
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DS_1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.IncSearch = DataLink_Company.SHuangSe
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
Styles.Inactive = DataLink_Company.SHuangSe
Styles.Selection = DataLink_Company.SHuangSe
object v2Column2: TcxGridDBColumn
Caption = #23458#25143#32534#21495
DataBinding.FieldName = 'CoCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 86
end
object v2Column6: TcxGridDBColumn
Caption = #23458#25143#20840#31216
DataBinding.FieldName = 'CoName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Options.Focusing = False
Width = 127
end
object v2Column15: TcxGridDBColumn
Caption = #23458#25143#31616#31216
DataBinding.FieldName = 'CoAbbrName'
HeaderAlignmentHorz = taCenter
Width = 94
end
object v2Column10: TcxGridDBColumn
Caption = #19994#21153#21592
DataBinding.FieldName = 'Saleser'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 100
end
object Tv1Column5: TcxGridDBColumn
Caption = #29702#21333
DataBinding.FieldName = 'Tallyer'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 111
end
object v2Column7: TcxGridDBColumn
Caption = #20844#21496#22320#22336
DataBinding.FieldName = 'CoAddress'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 97
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'Note'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 129
end
object v2Column3: TcxGridDBColumn
Caption = #22269#23478
DataBinding.FieldName = 'cocountry'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 65
end
object Tv1Column2: TcxGridDBColumn
Caption = #23458#25143#31561#32423
DataBinding.FieldName = 'CoLevel'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 76
end
object Tv1Column3: TcxGridDBColumn
Caption = #30331#35760#26102#38388
DataBinding.FieldName = 'Filltime'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 83
end
object Tv1Column4: TcxGridDBColumn
Caption = #30331#35760#20154
DataBinding.FieldName = 'Filler'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
object Tv1Column6: TcxGridDBColumn
Caption = #23458#25143#31867#22411
DataBinding.FieldName = 'KHType'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 66
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv1
end
end
object DS_1: TDataSource
DataSet = CDS_Import
Left = 500
Top = 248
end
object CDS_Import: TClientDataSet
Aggregates = <>
Params = <>
Left = 384
Top = 252
end
object GPM_1: TcxGridPopupMenu
PopupMenus = <>
Left = 296
Top = 104
end
object ADOQueryTmp: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 88
Top = 108
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 188
Top = 108
end
object OpenDialog1: TOpenDialog
Left = 386
Top = 170
end
object CDS_LM: TClientDataSet
Aggregates = <>
Params = <>
Left = 504
Top = 176
end
end

437
A01基础公司管理/U_CustomerImport.pas Normal file
View File

@ -0,0 +1,437 @@
unit U_CustomerImport;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, cxStyles, cxCustomData, cxGraphics, cxFilter,
cxData, cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, cxGridCustomPopupMenu, cxGridPopupMenu, ADODB,
DBClient, ExtCtrls, StdCtrls, BtnEdit, cxButtonEdit, cxTextEdit,
cxDropDownEdit, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, cxCalendar,
dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges, dxBarBuiltInMenu, ComObj,
cxCheckBox;
type
TfrmCustomerImport = class(TForm)
DS_1: TDataSource;
CDS_Import: TClientDataSet;
GPM_1: TcxGridPopupMenu;
ToolBar1: TToolBar;
TSave: TToolButton;
TBClose: TToolButton;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
OpenDialog1: TOpenDialog;
CDS_LM: TClientDataSet;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v2Column2: TcxGridDBColumn;
v2Column6: TcxGridDBColumn;
v2Column15: TcxGridDBColumn;
v2Column10: TcxGridDBColumn;
v2Column7: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TSaveClick(Sender: TObject);
procedure v1P_CodeNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure v1P_SpecPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure v1QtyUnitPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure FormDestroy(Sender: TObject);
procedure Tv1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure Tv1Column3PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure Tv1Column6PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure Tv1Column4PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure ToolButton4Click(Sender: TObject);
private
procedure initGrid();
procedure SaveDate();
{ Private declarations }
public
FCOID: string;
fInvoiceFlag: string;
{ Public declarations }
end;
var
frmCustomerImport: TfrmCustomerImport;
implementation
uses
U_RTFun, U_ZDYHelp, U_CompanySel, U_dataLink;
{$R *.dfm}
procedure TfrmCustomerImport.SaveDate();
var
MaxNo: string;
begin
ADOQueryCmd.Connection.BeginTrans;
try
with CDS_Import do
begin
first;
while not eof do
begin
if fieldbyname('COID').AsString = '' then
begin
if GetLSNo(ADOQueryTmp, MaxNo, 'CO', 'BS_Company', 4, 1) = False then
raise Exception.Create('取最大号失败！');
end
else
MaxNo := CDS_Import.fieldbyname('COID').AsString;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.add('select * from BS_Company where COID=' + quotedstr(Trim(MaxNo)));
open;
end;
if ADOQueryCmd.IsEmpty then
begin
ADOQueryCmd.append;
ADOQueryCmd.FieldByName('FillId').Value := Trim(DCode);
ADOQueryCmd.FieldByName('Filler').Value := Trim(DName);
ADOQueryCmd.FieldByName('status').Value := '0';
end
else
begin
ADOQueryCmd.edit;
ADOQueryCmd.FieldByName('EditId').Value := Trim(DCode);
ADOQueryCmd.FieldByName('Editer').Value := Trim(DName);
ADOQueryCmd.FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTmp);
end;
RTSetSaveDataCDS(ADOQueryCmd, Tv1, CDS_Import, 'BS_Company', 0);
ADOQueryCmd.fieldbyname('COID').Value := MaxNo;
ADOQueryCmd.FieldByName('CoType').Value := '客户';
ADOQueryCmd.Post;
next;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
application.MessageBox('保存成功！', '提示');
Modalresult := 1;
except
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmCustomerImport.initGrid();
begin
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('select * from BS_Company where 1=2');
open;
end;
SCreateCDS(ADOQueryTmp, CDS_Import);
SInitCDSData(ADOQueryTmp, CDS_Import);
end;
procedure TfrmCustomerImport.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmCustomerImport.FormShow(Sender: TObject);
begin
ReadCxGrid(Self.Caption, Tv1, '财务管理');
with CDS_LM do
begin
FieldDefs.Clear;
FieldDefs.Add('LXH', ftInteger, 0);
FieldDefs.Add('lCode', ftString, 40);
FieldDefs.Add('LName', ftString, 40);
close;
CreateDataSet;
end;
initGrid();
end;
procedure TfrmCustomerImport.TSaveClick(Sender: TObject);
begin
if CDS_Import.Locate('CoCode', null, []) then
begin
application.MessageBox('编号不能为空', '提示');
exit;
end;
if CDS_Import.Locate('CoName', null, []) then
begin
application.MessageBox('名称不能为空', '提示');
exit;
end;
if CDS_Import.Locate('CoAbbrName', null, []) then
begin
application.MessageBox('简称为空', '提示');
exit;
end;
SaveDate();
end;
procedure TfrmCustomerImport.v1P_CodeNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'MPRTCodeName';
flagname := '产品名称';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('P_CodeName').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
Self.CDS_Import.FieldByName('P_Code').Value := Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
//self.tv1.Controller.EditingController.ShowEdit();
end;
procedure TfrmCustomerImport.v1P_SpecPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'P_Spec';
flagname := '成品规格';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('P_Spec').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmCustomerImport.v1QtyUnitPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'QtyUnit';
flagname := '数量单位';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('QtyUnit').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmCustomerImport.FormDestroy(Sender: TObject);
begin
frmCustomerImport := nil;
end;
procedure TfrmCustomerImport.Tv1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '我司';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('OurCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OurCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmCustomerImport.Tv1Column3PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'InvoiceType';
flagname := '发票类型';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('IVType').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmCustomerImport.Tv1Column4PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '客户';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('OppCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OppCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
Self.CDS_Import.FieldByName('OppParentCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OppParentCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmCustomerImport.Tv1Column6PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '客户';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('OppParentCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OppParentCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmCustomerImport.ToolButton2Click(Sender: TObject);
begin
if CDS_Import.IsEmpty then
exit;
CDS_Import.delete;
end;
procedure TfrmCustomerImport.ToolButton3Click(Sender: TObject);
begin
WriteCxGrid(Self.Caption, Tv1, '财务管理');
end;
procedure TfrmCustomerImport.ToolButton4Click(Sender: TObject);
var
excelApp, WorkBook: Variant;
i, j, k, LX, ExcelRowCount: integer;
maxId, FCPID, FCPName, t1, t2, t3, COID: string;
begin
try
excelApp := CreateOleObject('Excel.Application');
openDialog1.Filter := '*.CSV;*.xls';
if opendialog1.Execute then
begin
WorkBook := excelApp.WorkBooks.Open(OpenDialog1.FileName);
end
else
exit;
excelApp.Visible := false;
ExcelRowCount := WorkBook.WorkSheets[1].UsedRange.Rows.Count;
except
application.MessageBox('加载EXCEL错误！', '错误信息', MB_ICONERROR);
exit;
end;
CDS_LM.EmptyDataSet;
for j := 0 to Tv1.ColumnCount - 1 do
begin
with CDS_LM do
begin
Append;
FieldByName('LCode').Value := trim(Tv1.Columns[j].DataBinding.FieldName);
FieldByName('LName').Value := trim(Tv1.Columns[j].Caption);
Post;
end;
end;
try
for i := 1 to 50 do
begin
if trim(WorkBook.WorkSheets[1].Cells[1, i].value) = '' then
continue;
if CDS_LM.Locate('LName', trim(WorkBook.WorkSheets[1].Cells[1, i].value), []) then
begin
with CDS_LM do
begin
Edit;
FieldByName('LXH').Value := i;
Post;
end;
end;
end;
except
application.MessageBox('加载数组错误！', '错误信息', MB_ICONERROR);
exit;
end;
try
for i := 2 to ExcelRowCount do
begin
with CDS_Import do
begin
Append;
CDS_LM.First;
while not CDS_LM.Eof do
begin
if CDS_LM.FieldByName('LXH').AsInteger > 0 then
CDS_Import.fieldbyname(CDS_LM.FieldByName('LCode').AsString).Value := WorkBook.WorkSheets[1].Cells[i, CDS_LM.FieldByName('LXH').AsInteger].Value;
CDS_LM.Next;
end;
Post;
end;
end;
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
except
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
exit;
end;
end;
end.

219
A01基础公司管理/U_CustomerInput.dfm Normal file
View File

@ -0,0 +1,219 @@
object frmCustomerInput: TfrmCustomerInput
Left = 261
Top = 149
Caption = #20844#21496#24405#20837
ClientHeight = 335
ClientWidth = 751
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Tag = 1
Left = 0
Top = 0
Width = 751
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 75
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object ToolButton3: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 16
OnClick = ToolButton3Click
end
object TBClose: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object ScrollBox1: TScrollBox
Left = 0
Top = 38
Width = 751
Height = 297
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
BorderStyle = bsNone
Color = clWhite
Ctl3D = False
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -14
Font.Name = #23435#20307
Font.Style = []
ParentColor = False
ParentCtl3D = False
ParentFont = False
TabOrder = 1
object Label2: TLabel
Left = 16
Top = 15
Width = 52
Height = 12
Caption = #20844#21496#32534#21495
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label6: TLabel
Left = 253
Top = 15
Width = 52
Height = 12
Caption = #20844#21496#21517#31216
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label39: TLabel
Left = 16
Top = 57
Width = 52
Height = 12
Caption = #20844#21496#22320#22336
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label7: TLabel
Left = 17
Top = 101
Width = 54
Height = 12
Caption = #22791' '#27880
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 495
Top = 15
Width = 52
Height = 12
Caption = #20844#21496#31616#31216
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object CoName: TEdit
Tag = 2
Left = 311
Top = 12
Width = 150
Height = 18
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
end
object CoCode: TEdit
Tag = 2
Left = 73
Top = 12
Width = 150
Height = 18
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
end
object CoAddress: TEdit
Tag = 2
Left = 73
Top = 55
Width = 621
Height = 18
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
end
object CoNote: TMemo
Tag = 2
Left = 77
Top = 97
Width = 636
Height = 52
ScrollBars = ssVertical
TabOrder = 3
end
object CoAbbrName: TEdit
Tag = 2
Left = 553
Top = 10
Width = 141
Height = 20
TabOrder = 4
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 331
Top = 200
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 158
Top = 192
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 237
Top = 193
end
end

276
A01基础公司管理/U_CustomerInput.pas Normal file
View File

@ -0,0 +1,276 @@
unit U_CustomerInput;
interface
uses
Windows, Messages, StrUtils, 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, cxDropDownEdit, BtnEdit, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges,
dxBarBuiltInMenu, U_BaseList, cxContainer, dxCore, cxDateUtils, cxImage,
cxDBEdit, IdExplicitTLSClientServerBase;
type
TfrmCustomerInput = class(TForm)
ToolBar1: TToolBar;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ToolButton3: TToolButton;
ScrollBox1: TScrollBox;
Label2: TLabel;
Label6: TLabel;
Label39: TLabel;
CoName: TEdit;
CoCode: TEdit;
CoAddress: TEdit;
Label7: TLabel;
CoNote: TMemo;
CoAbbrName: TEdit;
Label3: TLabel;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure CoareaBtnDnClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
function SaveData(): Boolean;
public
fFlileFlag: string;
fkhType: string;
{ Public declarations }
FCOID: string;
end;
var
frmCustomerInput: TfrmCustomerInput;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp, getpic, U_YWYSel;
{$R *.dfm}
procedure TfrmCustomerInput.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company where CoType=''我司'' and COID=''' + Trim(FCOID) + '''');
Open;
end;
SCSHData(ADOQueryMain, ScrollBox1, 2);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCustomerInput.FormDestroy(Sender: TObject);
begin
frmCustomerInput := nil;
end;
procedure TfrmCustomerInput.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmCustomerInput.TBCloseClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmCustomerInput.FormShow(Sender: TObject);
begin
InitGrid();
if CoCode.Text <> '' then
exit;
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add(' exec P_BS_Com_Get_No @Str=''W'' ');
Open;
end;
CoCode.Text := trim(ADOQueryTemp.FieldByName('NewCoCode').asstring);
end;
procedure TfrmCustomerInput.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
function TfrmCustomerInput.SaveData(): Boolean;
var
MaxId, MaxSubId, FCoCode, FCCID, MaxCFID: string;
begin
try
ADOQueryCmd.Connection.BeginTrans;
if Trim(FCOID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxId, 'CO', 'BS_Company', 4, 1) = False then
begin
Result := False;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败！', '提示', 0);
Exit;
end;
if trim(CoCode.Text) = '' then
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add(' exec P_BS_Com_Get_No @Str=''W'' ');
Open;
end;
CoCode.Text := trim(ADOQueryTemp.FieldByName('NewCoCode').asstring);
end;
end
else
begin
MaxId := Trim(FCOID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from BS_Company where COID=''' + Trim(FCOID) + '''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FCOID) = '' then
begin
Append;
FieldByName('Filler').Value := Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('COID').Value := Trim(MaxId);
RTSetsavedata(ADOQueryCmd, 'BS_Company', ScrollBox1, 2);
FieldByName('CoType').Value := '我司';
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoCode=' + quotedstr(trim(CoCode.Text)));
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('编号重复!', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoName=' + quotedstr(trim(CoName.Text)));
sql.Add(' and CoType=''我司'' ');
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('名称重复!', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoAbbrName=' + quotedstr(trim(CoAbbrName.Text)));
sql.Add(' and CoType=''我司'' ');
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('简称重复!', '提示', 0);
Exit;
end;
//////////////// 更新名称 ////////////////////////
// with ADOQueryCmd do
// begin
// Close;
// sql.Clear;
// sql.Add('exec P_Com_Up_Code @COID=' + quotedstr(Trim(MaxId)));
// ExecSQL;
// end;
//////////////// 更新名称 ////////////////////////
ADOQueryCmd.Connection.CommitTrans;
FCCID := Trim(MaxSubId);
Result := True;
except
Result := false;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存异常!', '提示', 0);
end;
end;
procedure TfrmCustomerInput.ToolButton3Click(Sender: TObject);
begin
if Trim(CoAbbrName.Text) = '' then
begin
Application.MessageBox('简称不能为空!', '提示', 0);
Exit;
end;
if Trim(CoName.Text) = '' then
begin
Application.MessageBox('名称不能为空!', '提示', 0);
Exit;
end;
if SaveData() then
begin
Application.MessageBox('保存成功!', '提示', 0);
end;
end;
procedure TfrmCustomerInput.CoareaBtnDnClick(Sender: TObject);
begin
TBtnEditC(Sender).Text := '';
TBtnEditC(Sender).TxtCode := '';
end;
end.

14280
A01基础公司管理/U_DataLink.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

128
A01基础公司管理/U_DataLink.pas Normal file
View File

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

70
A01基础公司管理/U_DeptTypeHelp.dfm Normal file
View File

@ -0,0 +1,70 @@
object frmDeptTypeHelp: TfrmDeptTypeHelp
Left = 526
Top = 238
Caption = #37096#38376#36873#25321#21015#34920
ClientHeight = 485
ClientWidth = 355
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 = 225
Height = 485
Align = alLeft
Bands = <
item
end>
DataController.DataSource = DataSource1
DataController.ParentField = 'DPParent'
DataController.KeyField = 'DPID'
Navigator.Buttons.CustomButtons = <>
OptionsBehavior.CopyCaptionsToClipboard = False
OptionsBehavior.ExpandOnDblClick = False
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
Styles.Inactive = DataLink_StaffManage.Red
Styles.Selection = DataLink_StaffManage.Red
Styles.IncSearch = DataLink_StaffManage.Red
TabOrder = 0
OnDblClick = cxDBTreeList1DblClick
ExplicitHeight = 486
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'DPName'
Width = 210
Position.ColIndex = 0
Position.RowIndex = 0
Position.BandIndex = 0
Summary.FooterSummaryItems = <>
Summary.GroupFooterSummaryItems = <>
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

73
A01基础公司管理/U_DeptTypeHelp.pas Normal file
View File

@ -0,0 +1,73 @@
unit U_DeptTypeHelp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, DB, ADODB, cxLookAndFeels,
cxLookAndFeelPainters, cxTLdxBarBuiltInMenu, dxSkinsCore,
dxSkinsDefaultPainters;
type
TfrmDeptTypeHelp = class(TForm)
ADOConnection1: TADOConnection;
DataSource1: TDataSource;
ADOQueryHelp: TADOQuery;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmDeptTypeHelp: TfrmDeptTypeHelp;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmDeptTypeHelp.FormCreate(Sender: TObject);
begin
cxDBTreeList1.Align := alclient;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
//ConnectionString:='';
Connected := true;
end;
except
end;
end;
procedure TfrmDeptTypeHelp.FormShow(Sender: TObject);
begin
with ADOQueryHelp do
begin
Close;
SQL.Clear;
SQL.Add('select * from SY_Dept order by DPlevel,DPOrder,DPName');
// SQL.Add('select * from CP_Type order by CPlevel,CPOrder,CPName');
Open;
end;
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmDeptTypeHelp.cxDBTreeList1DblClick(Sender: TObject);
begin
if ADOQueryHelp.IsEmpty then
exit;
ModalResult := 1;
end;
end.

241
A01基础公司管理/U_EmployeeInPut.dfm Normal file
View File

@ -0,0 +1,241 @@
object frmYGInPut: TfrmYGInPut
Left = 191
Top = 31
Caption = #21592#24037#26723#26696#24405#20837
ClientHeight = 532
ClientWidth = 1429
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Tag = 1
Left = 0
Top = 0
Width = 1429
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 75
Caption = 'ToolBar1'
Color = clBtnFace
DisabledImages = DataLink_Company.ImageList_new32
EdgeInner = esNone
EdgeOuter = esNone
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ParentFont = False
ShowCaptions = True
TabOrder = 0
ExplicitWidth = 1144
object TBSave: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 16
OnClick = TBSaveClick
end
object ToolButton1: TToolButton
Left = 71
Top = 0
Caption = #22686#34892
ImageIndex = 2
OnClick = ToolButton1Click
end
object ToolButton2: TToolButton
Left = 146
Top = 0
Caption = #21024#34892
ImageIndex = 6
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 221
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid1: TcxGrid
Left = 0
Top = 38
Width = 1429
Height = 494
Align = alClient
TabOrder = 1
ExplicitTop = 44
ExplicitWidth = 1144
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
DataController.DataSource = DataSource1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsView.GroupByBox = False
OptionsView.GroupFooters = gfAlwaysVisible
Styles.Header = cxStyle1
object v1RuZhiDate: TcxGridDBColumn
Caption = #20837#32844#26085#26399
DataBinding.FieldName = 'EntryDate'
HeaderAlignmentHorz = taCenter
Width = 70
end
object v1YGNo: TcxGridDBColumn
Caption = #21592#24037#32534#21495
DataBinding.FieldName = 'EECode'
HeaderAlignmentHorz = taCenter
Width = 75
end
object v1YGName: TcxGridDBColumn
Caption = #22995#21517
DataBinding.FieldName = 'EEName'
HeaderAlignmentHorz = taCenter
Width = 88
end
object v1Column1: TcxGridDBColumn
Caption = #37096#38376
DataBinding.FieldName = 'Dept'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 80
end
object v1GangWei: TcxGridDBColumn
Caption = #23703#20301
DataBinding.FieldName = 'Post'
HeaderAlignmentHorz = taCenter
Width = 82
end
object v1SFZNo: TcxGridDBColumn
Caption = #29983#26085
DataBinding.FieldName = 'Birthday'
HeaderAlignmentHorz = taCenter
Width = 70
end
object v1YGSex: TcxGridDBColumn
Caption = #24615#21035
DataBinding.FieldName = 'Sex'
PropertiesClassName = 'TcxComboBoxProperties'
Properties.DropDownListStyle = lsEditFixedList
Properties.Items.Strings = (
#30007
#22899)
HeaderAlignmentHorz = taCenter
Width = 85
end
object v1Phone: TcxGridDBColumn
Caption = #25163#26426
DataBinding.FieldName = 'Phone'
HeaderAlignmentHorz = taCenter
Width = 91
end
object Tv1Column1: TcxGridDBColumn
Caption = #36523#20221#35777
DataBinding.FieldName = 'IdCard'
HeaderAlignmentHorz = taCenter
Width = 73
end
object Tv1Column2: TcxGridDBColumn
Caption = #36523#20221#35777#21040#26399#26085#26399
DataBinding.FieldName = 'IDCardEndData'
HeaderAlignmentHorz = taCenter
Width = 115
end
object Tv1Column3: TcxGridDBColumn
Caption = #23478#24237#20303#22336
DataBinding.FieldName = 'HomeAddress'
HeaderAlignmentHorz = taCenter
Width = 104
end
object Tv1Column4: TcxGridDBColumn
Caption = #25143#21475#25152#22312#22320
DataBinding.FieldName = 'Domicile'
HeaderAlignmentHorz = taCenter
Width = 91
end
object Tv1Column5: TcxGridDBColumn
Caption = #31038#20445
DataBinding.FieldName = 'SocialSecurity'
PropertiesClassName = 'TcxComboBoxProperties'
Properties.Items.Strings = (
''
#32564#32435)
HeaderAlignmentHorz = taCenter
Width = 71
end
object Tv1Column6: TcxGridDBColumn
Caption = #21830#19994#20445#38505
DataBinding.FieldName = 'CommercialInsurance'
PropertiesClassName = 'TcxComboBoxProperties'
Properties.Items.Strings = (
''
#32564#32435)
HeaderAlignmentHorz = taCenter
Width = 74
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
object ADOTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 496
Top = 157
end
object ADOCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 341
Top = 135
end
object DataSource1: TDataSource
DataSet = Order_Sub
Left = 666
Top = 145
end
object Order_Sub: TClientDataSet
Aggregates = <>
Params = <>
Left = 760
Top = 178
end
object cxStyleRepository1: TcxStyleRepository
Left = 616
Top = 80
PixelsPerInch = 96
object cxStyle1: TcxStyle
AssignedValues = [svFont]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
end
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 566
Top = 201
end
end

320
A01基础公司管理/U_EmployeeInPut.pas Normal file
View File

@ -0,0 +1,320 @@
unit U_EmployeeInPut;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, cxMemo,
cxRichEdit, ComCtrls, cxContainer, cxTextEdit, cxMaskEdit, cxButtonEdit,
StdCtrls, ToolWin, DBClient, ADODB, ExtCtrls, BtnEdit, cxCalendar, StrUtils,
cxDropDownEdit, jpeg, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, cxPC, cxGridCustomPopupMenu, cxGridPopupMenu, Menus,
ExtDlgs, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxSkinsCore,
dxSkinsDefaultPainters, dxDateRanges, dxBarBuiltInMenu;
type
TfrmYGInPut = class(TForm)
ToolBar1: TToolBar;
TBClose: TToolButton;
ADOTemp: TADOQuery;
ADOCmd: TADOQuery;
TBSave: TToolButton;
DataSource1: TDataSource;
Order_Sub: TClientDataSet;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1YGName: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1GangWei: TcxGridDBColumn;
v1YGSex: TcxGridDBColumn;
v1Phone: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
v1RuZhiDate: TcxGridDBColumn;
cxGridPopupMenu1: TcxGridPopupMenu;
v1SFZNo: TcxGridDBColumn;
v1YGNo: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure v1SYRNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure v1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
private
TPInt: Integer;
procedure InitData();
function SaveData(): Boolean;
function SaveMXData(Tv11: TcxGridDBTableView; CDS1: TClientDataSet; FMaxNo, FYOType: string): Boolean;
procedure SaveImageOther();
procedure InitImage();
{ Private declarations }
public
canshu1: string;
PState, CopyInt: Integer;
FMainId, FDPID, FDPName: string;
{ Public declarations }
end;
var
frmYGInPut: TfrmYGInPut;
implementation
uses
U_DataLink, U_ZDYHelp, U_RTFun;
{$R *.dfm}
procedure TfrmYGInPut.TBCloseClick(Sender: TObject);
begin
WriteCxGrid('员工档案录入2', Tv1, '管理');
Close;
end;
procedure TfrmYGInPut.InitData();
begin
with ADOCmd do
begin
Close;
sql.Clear;
sql.Add('select * from SY_Employee where EEID=''' + Trim(FMainId) + '''');
Open;
end;
SCreateCDS(ADOCmd, Order_Sub);
SInitCDSData(ADOCmd, Order_Sub);
end;
procedure TfrmYGInPut.FormShow(Sender: TObject);
begin
ReadCxGrid('员工档案录入2', Tv1, '管理');
InitData();
end;
function TfrmYGInPut.SaveData(): Boolean;
var
maxno, FHZStatus: string;
begin
Result := False;
try
ADOCmd.Connection.BeginTrans;
with Order_Sub do
begin
first;
while not eof do
begin
if Trim(Order_Sub.fieldbyname('EEID').AsString) = '' then
begin
if GetLSNo(ADOCmd, maxno, 'OA', 'SY_Employee', 4, 1) = False then
begin
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
end
else
begin
maxno := Trim(Order_Sub.fieldbyname('EEID').AsString);
end;
with ADOCmd do
begin
Close;
sql.Clear;
SQL.Add('select * from SY_Employee where EEID=''' + Trim(maxno) + '''');
Open;
end;
with ADOCmd do
begin
if ADOCmd.IsEmpty then
begin
Append;
FieldByName('Filler').Value := Trim(DName);
end
else
begin
edit;
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOTemp);
end;
FieldByName('EEID').Value := Trim(maxno);
FieldByName('EEType').Value := '正式';
fieldbyname('DPID').Value := Trim(FDPID);
RTSetSaveDataCDS(ADOCmd, Tv1, Order_Sub, 'SY_Employee', 0);
post;
end;
with ADOCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from SY_Employee where EECode=''' + Trim(Order_Sub.fieldbyname('EECode').AsString) + '''');
Open;
end;
if ADOCmd.RecordCount > 1 then
begin
ADOCmd.Connection.RollbackTrans;
application.MessageBox(PChar('员工编号' + trim(ADOCmd.fieldbyname('EECode').AsString) + '已存在'), '提示');
Exit;
end;
with Order_Sub do
begin
Edit;
FieldByName('EEID').Value := Trim(maxno);
end;
with ADOCmd do
begin
Close;
SQL.Clear;
sql.Add('exec P_EE_in_Account @DataID=''' + Trim(maxno) + '''');
Open;
end;
if ADOCmd.FieldByName('intReturn').AsInteger = -1 then
begin
ADOCmd.Connection.RollbackTrans;
Application.MessageBox(PChar(ADOCmd.fieldbyname('ShowMsg').AsString), '提示', 0);
exit;
end;
next;
end;
end;
ADOCmd.Connection.CommitTrans;
Result := True;
except
;
Result := False;
ADOCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败！', '提示', 0);
end;
end;
function TfrmYGInPut.SaveMXData(Tv11: TcxGridDBTableView; CDS1: TClientDataSet; FMaxNo, FYOType: string): Boolean;
begin
end;
procedure TfrmYGInPut.InitImage();
begin
end;
procedure TfrmYGInPut.TBSaveClick(Sender: TObject);
var
FSFNO: string;
begin
ToolBar1.SetFocus;
if Order_Sub.Locate('IdCard', '', []) = true then
begin
application.MessageBox('身份证不能为空', '提示');
exit;
end;
if SaveData() then
begin
Application.MessageBox('保存成功！', '提示', 0);
ModalResult := 1;
end;
end;
procedure TfrmYGInPut.SaveImageOther();
begin
end;
procedure TfrmYGInPut.ToolButton1Click(Sender: TObject);
begin
with Order_Sub do
begin
Append;
fieldbyname('EntryDate').Value := SGetServerDate(ADOTemp);
FieldByName('Dept').Value := Trim(FDPName);
Post;
end;
end;
procedure TfrmYGInPut.ToolButton2Click(Sender: TObject);
begin
if Order_Sub.IsEmpty then
Exit;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
if Trim(Order_Sub.fieldbyname('EEID').AsString) <> '' then
begin
with ADOCmd do
begin
Close;
sql.Clear;
sql.Add('delete SY_Employee where EEID=''' + Trim(Order_Sub.fieldbyname('EEID').AsString) + '''');
ExecSQL;
end;
with ADOCmd do
begin
Close;
SQL.Clear;
sql.Add('exec P_EE_in_Account @DataID=''' + Trim(Order_Sub.fieldbyname('EEID').AsString) + '''');
Open;
end;
if ADOCmd.FieldByName('intReturn').AsInteger = -1 then
begin
Application.MessageBox(PChar(ADOCmd.fieldbyname('ShowMsg').AsString), '提示', 0);
exit;
end;
end;
Order_Sub.Delete;
end;
procedure TfrmYGInPut.v1SYRNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
frmZDYHelp := TfrmZDYHelp.Create(self);
with frmZDYHelp do
begin
flag := 'SYRName';
flagName := '车间';
if ShowModal = 1 then
begin
with Order_Sub do
begin
edit;
FieldByName('SYRName').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
free;
end;
end;
procedure TfrmYGInPut.v1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'BZName';
flagname := '班组名称';
if ShowModal = 1 then
begin
with Order_Sub do
begin
Edit;
FieldByName('BZName').Value := Trim(frmZDYHelp.ClientDataSet1.fieldbyname('ZdyName').AsString);
end;
end;
end;
finally
frmZDYHelp.Free;
end;
end;
end.

592
A01基础公司管理/U_EmployeeList.dfm Normal file
View File

@ -0,0 +1,592 @@
inherited frmEmployeeList: TfrmEmployeeList
Top = 39
Caption = #21592#24037#26723#26696#21015#34920
ClientHeight = 509
ClientWidth = 1523
ExplicitWidth = 1539
ExplicitHeight = 548
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1523
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_Company.ImageList_new32
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ParentFont = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
OnClick = TBFindClick
end
object TBAdd: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #26032#22686
ImageIndex = 9
OnClick = TBAddClick
end
object TBEdit: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20462#25913
ImageIndex = 3
OnClick = TBEditClick
end
object TBDel: TToolButton
Left = 284
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 3
OnClick = TBDelClick
end
object ToolButton2: TToolButton
Left = 355
Top = 0
AutoSize = True
Caption = #37096#38376#35843#25972
ImageIndex = 19
OnClick = ToolButton2Click
end
object TLZ: TToolButton
Left = 450
Top = 0
AutoSize = True
Caption = #31163#32844
ImageIndex = 17
OnClick = TLZClick
end
object Panel2: TPanel
Left = 521
Top = 0
Width = 155
Height = 38
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clWhite
ParentBackground = False
TabOrder = 0
DesignSize = (
155
38)
object Label6: TLabel
Left = 10
Top = 11
Width = 48
Height = 12
Anchors = [akLeft]
Caption = #31163#32844#26085#26399
end
object SJLiZhiDate: TDateTimePicker
Left = 60
Top = 7
Width = 90
Height = 20
Anchors = [akLeft]
Date = 43292.000000000000000000
Time = 0.850766331022896300
TabOrder = 0
end
end
object TCXLZ: TToolButton
Left = 676
Top = 0
AutoSize = True
Caption = #25764#38144#31163#32844
ImageIndex = 11
OnClick = TCXLZClick
end
object TBView: TToolButton
Left = 771
Top = 0
AutoSize = True
Caption = #26597#30475
ImageIndex = 8
OnClick = TBViewClick
end
object TBExport: TToolButton
Left = 842
Top = 0
AutoSize = True
Caption = #23548#20986
ImageIndex = 20
OnClick = TBExportClick
end
object TBClose: TToolButton
Left = 913
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object Panel1: TPanel [1]
Left = 0
Top = 38
Width = 1523
Height = 38
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clWhite
ParentBackground = False
TabOrder = 1
object Label1: TLabel
Left = 186
Top = 12
Width = 24
Height = 12
Caption = #22995#21517
end
object Label2: TLabel
Left = 426
Top = 12
Width = 24
Height = 12
Caption = #24615#21035
end
object Label5: TLabel
Left = 537
Top = 12
Width = 24
Height = 12
Caption = #23703#20301
end
object Label4: TLabel
Left = 309
Top = 12
Width = 24
Height = 12
Caption = #37096#38376
end
object Label3: TLabel
Left = 657
Top = 12
Width = 24
Height = 12
Caption = #36710#38388
end
object Label7: TLabel
Left = 43
Top = 12
Width = 48
Height = 12
Caption = #21592#24037#32534#21495
end
object YGName: TEdit
Tag = 2
Left = 211
Top = 8
Width = 83
Height = 20
TabOrder = 0
OnChange = YGNameChange
end
object YGSex: TComboBox
Tag = 1
Left = 452
Top = 8
Width = 70
Height = 20
Style = csDropDownList
TabOrder = 1
OnChange = YGNameChange
Items.Strings = (
#30007
#22899
'')
end
object GangWei: TEdit
Tag = 2
Left = 564
Top = 8
Width = 75
Height = 20
TabOrder = 2
OnChange = YGNameChange
end
object Dept: TEdit
Tag = 2
Left = 336
Top = 8
Width = 75
Height = 20
TabOrder = 3
OnChange = YGNameChange
end
object SYRName: TEdit
Tag = 2
Left = 684
Top = 8
Width = 75
Height = 20
TabOrder = 4
OnChange = YGNameChange
end
object YGNo: TEdit
Tag = 2
Left = 91
Top = 8
Width = 83
Height = 20
TabOrder = 5
OnChange = YGNameChange
end
end
object cxDBTreeList1: TcxDBTreeList [2]
Left = 0
Top = 76
Width = 225
Height = 433
Align = alLeft
Bands = <
item
end>
DataController.DataSource = DataSource2
DataController.ParentField = 'DPParent'
DataController.KeyField = 'DPID'
Navigator.Buttons.CustomButtons = <>
OptionsBehavior.CopyCaptionsToClipboard = False
OptionsBehavior.ExpandOnDblClick = False
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
Styles.Inactive = DataLink_Company.Red
Styles.Selection = DataLink_Company.Red
Styles.IncSearch = DataLink_Company.Red
TabOrder = 2
OnDblClick = cxDBTreeList1DblClick
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'DPName'
Width = 210
Position.ColIndex = 0
Position.RowIndex = 0
Position.BandIndex = 0
Summary.FooterSummaryItems = <>
Summary.GroupFooterSummaryItems = <>
end
end
object cxSplitter1: TcxSplitter [3]
Left = 225
Top = 76
Width = 8
Height = 433
HotZoneClassName = 'TcxMediaPlayer9Style'
Control = cxDBTreeList1
end
object TPanel [4]
Left = 233
Top = 76
Width = 1290
Height = 433
Align = alClient
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 4
object cxTabControl1: TcxTabControl
Left = 2
Top = 2
Width = 1286
Height = 25
Align = alTop
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
Properties.CustomButtons.Buttons = <>
Properties.Style = 3
Properties.TabIndex = 0
Properties.Tabs.Strings = (
#22312#32844
#31163#32844
#20840#37096)
OnChange = cxTabControl1Change
ClientRectBottom = 28
ClientRectRight = 1286
ClientRectTop = 28
end
object cxGrid1: TcxGrid
Left = 2
Top = 27
Width = 1286
Height = 404
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 1
ExplicitLeft = 6
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
DataController.DataSource = DataSource1
DataController.Filter.AutoDataSetFilter = True
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsView.GroupByBox = False
OptionsView.GroupFooters = gfAlwaysVisible
Styles.Header = cxStyle1
object v1Column4: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
HeaderAlignmentHorz = taCenter
Width = 52
end
object v1RuZhiDate: TcxGridDBColumn
Caption = #20837#32844#26085#26399
DataBinding.FieldName = 'EntryDate'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 84
end
object v1YGNo: TcxGridDBColumn
Caption = #32534#21495
DataBinding.FieldName = 'EECode'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 70
end
object v1YGName: TcxGridDBColumn
Caption = #22995#21517
DataBinding.FieldName = 'EEName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 88
end
object v1Column1: TcxGridDBColumn
Caption = #37096#38376
DataBinding.FieldName = 'Dept'
PropertiesClassName = 'TcxButtonEditProperties'
Properties.Buttons = <
item
Default = True
Kind = bkEllipsis
end>
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 80
end
object v1Column2: TcxGridDBColumn
Caption = #23703#20301
DataBinding.FieldName = 'Post'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 82
end
object v1Column8: TcxGridDBColumn
Caption = #31867#21035
DataBinding.FieldName = 'EEType'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 84
end
object v1SFZNo: TcxGridDBColumn
Caption = #36523#20221#35777#21495
DataBinding.FieldName = 'IdCard'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 83
end
object v1Column6: TcxGridDBColumn
Caption = #24615#21035
DataBinding.FieldName = 'Sex'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 89
end
object v1Column29: TcxGridDBColumn
Caption = #25163#26426
DataBinding.FieldName = 'Phone'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 98
end
object v1SJLiZhiDate: TcxGridDBColumn
Caption = #31163#32844#26085#26399
DataBinding.FieldName = 'SJLiZhiDate'
PropertiesClassName = 'TcxDateEditProperties'
Properties.SaveTime = False
Properties.ShowTime = False
Visible = False
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 70
end
object Tv1Column1: TcxGridDBColumn
Caption = #31163#32844#26102#38388
DataBinding.FieldName = 'DepartureDate'
HeaderAlignmentHorz = taCenter
Width = 88
end
object Tv1Column2: TcxGridDBColumn
Caption = #36523#20221#35777#21040#26399#26085#26399
DataBinding.FieldName = 'IDCardEndData'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 126
end
object Tv1Column3: TcxGridDBColumn
Caption = #23478#24237#20303#22336
DataBinding.FieldName = 'HomeAddress'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 89
end
object Tv1Column4: TcxGridDBColumn
Caption = #25143#21475#25152#22312#22320
DataBinding.FieldName = 'Domicile'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 91
end
object Tv1Column5: TcxGridDBColumn
Caption = #31038#20445
DataBinding.FieldName = 'SocialSecurity'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 69
end
object Tv1Column6: TcxGridDBColumn
Caption = #21830#19994#20445#38505
DataBinding.FieldName = 'CommercialInsurance'
HeaderAlignmentHorz = taCenter
Width = 74
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_Company.ADOLink
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 385
Top = 129
end
object cxGridPopupMenu1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 563
Top = 201
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 432
Top = 200
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 392
Top = 200
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 357
Top = 203
end
object DataSource1: TDataSource
DataSet = Order_Main
Left = 497
Top = 201
end
object Order_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 531
Top = 200
end
object PopupMenu1: TPopupMenu
Left = 321
Top = 205
object N2: TMenuItem
Caption = #20840#36873
OnClick = N2Click
end
object N1: TMenuItem
Caption = #20840#24323
OnClick = N1Click
end
end
object DataSource2: TDataSource
DataSet = CDS_Tree
Left = 147
Top = 219
end
object CDS_Tree: TClientDataSet
Aggregates = <>
Params = <>
Left = 96
Top = 256
end
object ADOQueryTree: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 117
Top = 145
end
object ADOQuery1: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 460
Top = 200
end
object cxStyleRepository1: TcxStyleRepository
Left = 48
Top = 96
PixelsPerInch = 96
object cxStyle1: TcxStyle
AssignedValues = [svFont]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
end
end
end

613
A01基础公司管理/U_EmployeeList.pas Normal file
View File

@ -0,0 +1,613 @@
unit U_EmployeeList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, ToolWin, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB,
cxGridCustomPopupMenu, cxGridPopupMenu, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView,
cxGrid, DBClient, cxCheckBox, cxCalendar, cxSplitter, RM_Dataset, RM_System,
RM_Common, RM_Class, RM_GridReport, RM_e_Xls, Menus, cxButtonEdit,
cxDropDownEdit, cxPC, cxTL, cxMaskEdit, cxInplaceContainer, cxDBTL, cxTLData,
cxLookAndFeels, cxLookAndFeelPainters, cxTLdxBarBuiltInMenu, dxBarBuiltInMenu,
cxNavigator, U_BaseList, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges;
type
TfrmEmployeeList = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBFind: TToolButton;
TBAdd: TToolButton;
TBEdit: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
cxGridPopupMenu1: TcxGridPopupMenu;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
DataSource1: TDataSource;
TBExport: TToolButton;
Order_Main: TClientDataSet;
TBView: TToolButton;
Panel1: TPanel;
PopupMenu1: TPopupMenu;
N2: TMenuItem;
N1: TMenuItem;
Label1: TLabel;
YGName: TEdit;
Label2: TLabel;
YGSex: TComboBox;
Label5: TLabel;
GangWei: TEdit;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DataSource2: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
cxSplitter1: TcxSplitter;
cxTabControl1: TcxTabControl;
TLZ: TToolButton;
ADOQuery1: TADOQuery;
TCXLZ: TToolButton;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1RuZhiDate: TcxGridDBColumn;
v1YGName: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column29: TcxGridDBColumn;
v1SJLiZhiDate: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Label4: TLabel;
Dept: TEdit;
v1SFZNo: TcxGridDBColumn;
Label3: TLabel;
SYRName: TEdit;
Panel2: TPanel;
Label6: TLabel;
SJLiZhiDate: TDateTimePicker;
v1YGNo: TcxGridDBColumn;
Label7: TLabel;
YGNo: TEdit;
ToolButton2: TToolButton;
v1Column4: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBFindClick(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBExportClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure TBViewClick(Sender: TObject);
procedure CustomerNoNameChange(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
procedure YGNameChange(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure Tv1CellClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
procedure TLZClick(Sender: TObject);
procedure TCXLZClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
private
canshu1: string;
DQdate: TDateTime;
procedure InitGrid();
procedure InitForm();
procedure InitTree();
procedure GLAge();
{ Private declarations }
public
FFInt, FCloth: Integer;
{ Public declarations }
end;
var
frmEmployeeList: TfrmEmployeeList;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp, U_EmployeeInPut, U_DeptTypeHelp; // U_FjList_RZ,
{$R *.dfm}
procedure TfrmEmployeeList.FormDestroy(Sender: TObject);
begin
inherited;
frmEmployeeList := nil;
end;
procedure TfrmEmployeeList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmEmployeeList.FormCreate(Sender: TObject);
begin
inherited;
canshu1 := Trim(DParameters1);
SJLiZhiDate.Date := SGetServerDate(ADOQueryTemp);
cxgrid1.Align := alClient;
end;
procedure TfrmEmployeeList.TBCloseClick(Sender: TObject);
begin
Close;
WriteCxGrid('员工档案列表2', Tv1, 'OA管理');
end;
procedure TfrmEmployeeList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
sql.Clear;
sql.Add(' exec P_EE_Get_All :DPID,:LiZhiFlag');
Parameters.ParamByName('DPID').Value := Trim(CDS_Tree.fieldbyname('DPID').AsString);
Parameters.ParamByName('LiZhiFlag').Value := cxTabControl1.TabIndex;
Open;
end;
SCreateCDS(ADOQueryMain, Order_Main);
SInitCDSData(ADOQueryMain, Order_Main);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmEmployeeList.GLAge();
var
FXTGLNF, FYGGLNF, FGLYF: Double;
begin
FXTGLNF := strtofloat(uppercase(formatdateTime('yyyy', SGetServerDate(ADOQueryTemp))));
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('select RuZhiDate,YGYearGL from SY_Employee where YGType=''正式'' ');
open;
end;
with ADOQueryCmd do
begin
first;
while not eof do
begin
edit;
if ADOQueryCmd.fieldbyname('RuZhiDate').asstring = '' then
begin
fieldbyname('YGYearGL').AsFloat := 0;
end
else
begin
FYGGLNF := strtofloat(uppercase(formatdateTime('yyyy', ADOQueryCmd.fieldbyname('RuZhiDate').AsDateTime)));
FGLYF := strtofloat(uppercase(formatdateTime('MM', ADOQueryCmd.fieldbyname('RuZhiDate').AsDateTime)));
if (FGLYF >= 1) and (FGLYF <= 3) then
fieldbyname('YGYearGL').AsFloat := FXTGLNF - FYGGLNF + 1;
if (FGLYF > 3) and (FGLYF <= 9) then
fieldbyname('YGYearGL').AsFloat := FXTGLNF - FYGGLNF + 0.5;
if (FGLYF > 9) and (FGLYF <= 12) then
fieldbyname('YGYearGL').AsFloat := FXTGLNF - FYGGLNF;
end;
next;
end;
end;
end;
procedure TfrmEmployeeList.InitTree();
var
i: Integer;
begin
try
ADOQueryTree.DisableControls;
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from SY_Dept order by DPlevel,DPOrder,DPName');
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(True);
finally
ADOQueryTree.EnableControls;
end;
end;
procedure TfrmEmployeeList.InitForm();
begin
ReadCxGrid('员工档案列表2', Tv1, 'OA管理');
InitTree();
// GLAge();
InitGrid();
end;
procedure TfrmEmployeeList.TBFindClick(Sender: TObject);
begin
if ADOQueryMain.Active = False then
Exit;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, Order_Main);
SInitCDSData(ADOQueryMain, Order_Main);
end;
procedure TfrmEmployeeList.TBEditClick(Sender: TObject);
begin
if Order_Main.IsEmpty then
Exit;
try
frmYGInPut := TfrmYGInPut.Create(Application);
with frmYGInPut do
begin
PState := 1;
FMainId := Trim(Self.Order_Main.fieldbyname('EEID').AsString);
FDPID := Trim(CDS_Tree.fieldbyname('DPID').AsString);
FDPName := trim(CDS_Tree.fieldbyname('DPName').AsString);
frmYGInPut.canshu1 := Trim(Self.canshu1);
if ShowModal = 1 then
begin
initgrid();
end;
end;
finally
frmYGInPut.Free;
end;
end;
procedure TfrmEmployeeList.TBDelClick(Sender: TObject);
begin
if Order_Main.IsEmpty then
Exit;
//if cxTabControl1.TabIndex<>0 then Exit;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
try
ADOQueryCmd.Connection.BeginTrans;
with Order_Main do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('ssel').AsBoolean then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Delete SY_Employee where EEID=''' + Trim(Order_Main.fieldbyname('EEID').AsString) + '''');
sql.Add('Delete SY_User where UserID=''' + Trim(Order_Main.fieldbyname('EECode').AsString) + '''');
sql.Add('Delete TP_File where TFType=''YG'' and WBId=''' + Trim(Order_Main.fieldbyname('EEID').AsString) + '''');
ExecSQL;
end;
end;
next;
end;
EnableControls;
end;
ADOQueryCmd.Connection.CommitTrans;
InitGrid();
except
ADOQueryCmd.Connection.RollbackTrans;
Order_Main.EnableControls;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmEmployeeList.TBExportClick(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then
Exit;
TcxGridToExcel('员工档案列表', cxGrid1);
end;
procedure TfrmEmployeeList.TBRafreshClick(Sender: TObject);
begin
InitTree();
InitGrid();
end;
procedure TfrmEmployeeList.TBAddClick(Sender: TObject);
var
maxno: string;
begin
try
frmYGInPut := TfrmYGInPut.Create(Application);
with frmYGInPut do
begin
PState := 0;
FMainId := '';
FDPID := Trim(CDS_Tree.fieldbyname('DPID').AsString);
FDPName := trim(CDS_Tree.fieldbyname('DPName').AsString);
if ShowModal = 1 then
begin
initgrid();
end;
end;
finally
frmYGInPut.Free;
end;
end;
procedure TfrmEmployeeList.FormShow(Sender: TObject);
begin
inherited;
v1SJLiZhiDate.Visible := false;
if cxTabControl1.TabIndex <> 0 then
v1SJLiZhiDate.Visible := true;
InitForm();
end;
procedure TfrmEmployeeList.CheckBox1Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmEmployeeList.CheckBox2Click(Sender: TObject);
begin
TBRafresh.Click;
end;
procedure TfrmEmployeeList.TBViewClick(Sender: TObject);
begin
if Order_Main.IsEmpty then
Exit;
try
frmYGInPut := TfrmYGInPut.Create(Application);
with frmYGInPut do
begin
PState := 1;
FMainId := Trim(Self.Order_Main.fieldbyname('EEID').AsString);
FDPID := Trim(CDS_Tree.fieldbyname('DPID').AsString);
TBSave.Visible := False;
ToolButton1.Visible := False;
ToolButton2.Visible := False;
if ShowModal = 1 then
begin
end;
end;
finally
frmYGInPut.Free;
end;
end;
procedure TfrmEmployeeList.CustomerNoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active = False then
Exit;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, Order_Main);
SInitCDSData(ADOQueryMain, Order_Main);
end;
procedure TfrmEmployeeList.N2Click(Sender: TObject);
begin
SelOKNo(Order_Main, True);
end;
procedure TfrmEmployeeList.N1Click(Sender: TObject);
begin
SelOKNo(Order_Main, False);
end;
procedure TfrmEmployeeList.cxTabControl1Change(Sender: TObject);
begin
v1SJLiZhiDate.Visible := false;
if cxTabControl1.TabIndex <> 0 then
v1SJLiZhiDate.Visible := true;
InitGrid();
end;
procedure TfrmEmployeeList.Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
begin
TBView.Click;
end;
procedure TfrmEmployeeList.YGNameChange(Sender: TObject);
begin
TBFind.Click;
end;
procedure TfrmEmployeeList.cxDBTreeList1DblClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmEmployeeList.Tv1CellClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
begin
if Order_Main.IsEmpty then
Exit;
CDS_Tree.Locate('DPID', Trim(Order_Main.fieldbyname('DPID').AsString), []);
end;
procedure TfrmEmployeeList.TLZClick(Sender: TObject);
begin
if order_Main.IsEmpty then
exit;
if CxTabConTrol1.TabIndex <> 0 then
exit;
if application.MessageBox('确定要执行此操作', '提示', 1) = 2 then
exit;
try
ADOQueryCmd.Connection.BeginTrans;
with Order_Main do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('ssel').AsBoolean then
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('update SY_Employee set EEType=''离职'',DepartureDate=' + Quotedstr(trim(FormatDateTime('yyyy-MM-dd', SJLiZhiDate.Date))));
sql.Add(' where EEID=''' + trim(Order_Main.fieldbyname('EEID').AsString) + '''');
ExecSQL;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('exec P_EE_in_Account @DataID=''' + Trim(Order_Main.fieldbyname('EEID').AsString) + '''');
Open;
end;
if ADOQueryCmd.FieldByName('intReturn').AsInteger = -1 then
raise Exception.Create(PChar(ADOQueryCmd.fieldbyname('ShowMsg').AsString));
end;
next;
end;
EnableControls;
end;
ADOQueryCmd.Connection.CommitTrans;
InitGrid();
except
ADOQueryCmd.Connection.RollbackTrans;
Order_Main.EnableControls;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmEmployeeList.TCXLZClick(Sender: TObject);
begin
if order_Main.IsEmpty then
exit;
if cxTabControl1.TabIndex <> 1 then
exit;
if application.MessageBox('确定要撤销离职吗', '提示', 1) = 2 then
exit;
try
ADOQueryCmd.Connection.BeginTrans;
with Order_Main do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('ssel').AsBoolean then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update SY_Employee set EEType=''正式'',DepartureDate=NULL');
sql.Add(' where EEID=''' + trim(Order_Main.fieldbyname('EEID').AsString) + '''');
execsql;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('exec P_EE_in_Account @DataID=''' + Trim(Order_Main.fieldbyname('EEID').AsString) + '''');
Open;
end;
if ADOQueryCmd.FieldByName('intReturn').AsInteger = -1 then
raise Exception.Create(PChar(ADOQueryCmd.fieldbyname('ShowMsg').AsString));
end;
next;
end;
EnableControls;
end;
ADOQueryCmd.Connection.CommitTrans;
InitGrid();
except
ADOQueryCmd.Connection.RollbackTrans;
Order_Main.EnableControls;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmEmployeeList.ToolButton2Click(Sender: TObject);
var
FDPID, FName: string;
begin
if Order_Main.IsEmpty then
exit;
if Order_Main.Locate('ssel', true, []) = false then
begin
Application.MessageBox('没有选择数据!', '提示', 0);
Exit;
end;
FDPID := '';
FName := '';
frmDeptTypeHelp := TfrmDeptTypeHelp.create(self);
with frmDeptTypeHelp do
begin
if showmodal = 1 then
begin
FDPID := Trim(ADOQueryHelp.fieldbyname('DPID').AsString);
FName := Trim(ADOQueryHelp.fieldbyname('DPName').AsString);
end;
free;
end;
if trim(FDPID) = '' then
exit;
try
with Order_Main do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('ssel').AsBoolean then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update SY_Employee SET Dept=''' + trim(FName) + ''' ');
sql.Add(',DPID=''' + trim(FDPID) + ''' ');
sql.Add('where EEID=' + quotedstr(trim(Order_Main.fieldbyname('EEID').AsString)));
execsql;
end;
end;
next;
end;
First;
EnableControls;
end;
application.MessageBox('操作成功！', '提示信息');
initgrid();
except
Order_Main.EnableControls;
application.MessageBox('操作失败！', '提示信息', 0);
end;
end;
end.

478
A01基础公司管理/U_Factory.dfm Normal file
View File

@ -0,0 +1,478 @@
inherited frmFactory: TfrmFactory
Left = 160
Top = 149
Caption = #20379#24212#21830#36164#26009#31649#29702
ClientHeight = 801
ClientWidth = 1366
FormStyle = fsMDIChild
Position = poScreenCenter
Visible = True
ExplicitWidth = 1382
ExplicitHeight = 840
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1366
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 103
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object btnFind: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #36807#28388
ImageIndex = 0
Visible = False
OnClick = btnFindClick
end
object btnAdd: TToolButton
Left = 142
Top = 0
AutoSize = True
Caption = #26032#22686
ImageIndex = 9
OnClick = btnAddClick
end
object btnEdit: TToolButton
Left = 213
Top = 0
AutoSize = True
Caption = #20462#25913
ImageIndex = 3
OnClick = btnEditClick
end
object TBDel: TToolButton
Left = 284
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 5
OnClick = TBDelClick
end
object btnFollower: TToolButton
Left = 355
Top = 0
AutoSize = True
Caption = #25351#23450#36319#21333#21592
ImageIndex = 15
OnClick = btnFollowerClick
end
object btnChk: TToolButton
Left = 462
Top = 0
AutoSize = True
Caption = #23457#26680
ImageIndex = 12
OnClick = btnChkClick
end
object btnReChk: TToolButton
Left = 533
Top = 0
AutoSize = True
Caption = #25764#38144#23457#26680
ImageIndex = 11
OnClick = btnReChkClick
end
object ToolButton8: TToolButton
Left = 628
Top = 0
AutoSize = True
Caption = #38468#20214
ImageIndex = 22
OnClick = ToolButton8Click
end
object ToolButton2: TToolButton
Left = 699
Top = 0
AutoSize = True
Caption = #23548#20837
ImageIndex = 18
OnClick = ToolButton2Click
end
object ToolButton1: TToolButton
Left = 770
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton1Click
end
object TBClose: TToolButton
Left = 865
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object Panel1: TPanel [1]
Left = 0
Top = 38
Width = 1366
Height = 39
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clWhite
ParentBackground = False
TabOrder = 1
object Label3: TLabel
Left = 202
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 Label4: TLabel
Left = 383
Top = 13
Width = 60
Height = 12
Caption = #20379#24212#21830#31616#31216
end
object Label5: TLabel
Left = 565
Top = 13
Width = 60
Height = 12
Caption = #20379#24212#21830#31867#22411
end
object CoName: TEdit
Tag = 2
Left = 266
Top = 9
Width = 89
Height = 20
TabOrder = 1
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
object CoCode: TEdit
Tag = 2
Left = 85
Top = 9
Width = 89
Height = 20
TabOrder = 0
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
object CoAbbrName: TEdit
Tag = 2
Left = 447
Top = 9
Width = 89
Height = 20
TabOrder = 2
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
object CoBusinessType: TEdit
Tag = 2
Left = 628
Top = 9
Width = 89
Height = 20
TabOrder = 3
OnChange = CoCodeChange
OnKeyPress = CoCodeKeyPress
end
end
object cxGrid1: TcxGrid [2]
Left = 0
Top = 99
Width = 1366
Height = 372
Align = alClient
TabOrder = 2
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
OnFocusedRecordChanged = Tv1FocusedRecordChanged
DataController.DataSource = DS_1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
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
OptionsView.GroupByBox = False
Styles.IncSearch = DataLink_Company.SHuangSe
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
Styles.Inactive = DataLink_Company.SHuangSe
Styles.Selection = DataLink_Company.SHuangSe
object v2Column5: TcxGridDBColumn
Caption = #36873#25321
DataBinding.FieldName = 'SSel'
PropertiesClassName = 'TcxCheckBoxProperties'
Properties.ImmediatePost = True
HeaderAlignmentHorz = taCenter
Width = 49
end
object v2Column2: TcxGridDBColumn
Caption = #20379#24212#21830#32534#21495
DataBinding.FieldName = 'CoCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 86
end
object v2Column6: TcxGridDBColumn
Caption = #20379#24212#21830#20840#31216
DataBinding.FieldName = 'CoName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 127
end
object v2Column15: TcxGridDBColumn
Caption = #20379#24212#21830#31616#31216
DataBinding.FieldName = 'CoAbbrName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 100
end
object v2Column3: TcxGridDBColumn
Caption = #20379#24212#21830#31867#22411
DataBinding.FieldName = 'CoBusinessType'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 74
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'CONote'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 163
end
object v2Column12: TcxGridDBColumn
Caption = #25805#20316#21592
DataBinding.FieldName = 'Filler'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 60
end
object v2Column4: TcxGridDBColumn
Caption = #36319#21333#21592
DataBinding.FieldName = 'Follower'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 78
end
object Tv1Column1: TcxGridDBColumn
Caption = #19978#32423#21333#20301
DataBinding.FieldName = 'ParentCoName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 108
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv1
end
end
object Panel2: TPanel [3]
Left = 0
Top = 471
Width = 1366
Height = 330
Align = alBottom
Caption = 'Panel1'
TabOrder = 3
object cxGrid2: TcxGrid
Left = 1
Top = 1
Width = 1364
Height = 328
Align = alClient
TabOrder = 0
object Tv2: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DS_2
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
object v3Column3: TcxGridDBColumn
Caption = #40664#35748
DataBinding.FieldName = 'IsDefault'
PropertiesClassName = 'TcxCheckBoxProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 76
end
object Tv2Column1: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'Contacts'
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 70
end
object Tv2Column2: TcxGridDBColumn
Caption = #32852#31995#30005#35805
DataBinding.FieldName = 'bossphone'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 96
end
object cxGridDBColumn1: TcxGridDBColumn
Caption = #25163#26426#21495
DataBinding.FieldName = 'PhoneNumber'
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 93
end
object Tv2Column3: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'note'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 120
end
end
object cxGridLevel2: TcxGridLevel
GridView = Tv2
end
end
end
object cxTabControl1: TcxTabControl [4]
Left = 0
Top = 77
Width = 1366
Height = 22
Align = alTop
TabOrder = 4
Properties.CustomButtons.Buttons = <>
Properties.Style = 9
Properties.TabIndex = 0
Properties.Tabs.Strings = (
#26410#23457#26680
#24050#23457#26680
#20840#37096)
OnChange = cxTabControl1Change
ClientRectBottom = 22
ClientRectRight = 1366
ClientRectTop = 19
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_Company.ADOLink
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 137
Top = 121
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 501
Top = 137
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 613
Top = 145
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 277
Top = 225
end
object DS_1: TDataSource
DataSet = CDS_1
Left = 555
Top = 243
end
object CDS_1: TClientDataSet
Aggregates = <>
Params = <>
Left = 496
Top = 240
end
object CDS_2: TClientDataSet
Aggregates = <>
Params = <>
Left = 592
Top = 532
end
object DS_2: TDataSource
DataSet = CDS_2
Left = 685
Top = 555
end
object GPM_1: TcxGridPopupMenu
Grid = cxGrid1
PopupMenus = <>
Left = 422
Top = 246
end
object GPM_2: TcxGridPopupMenu
Grid = cxGrid2
PopupMenus = <>
Left = 390
Top = 542
end
end

612
A01基础公司管理/U_Factory.pas Normal file
View File

@ -0,0 +1,612 @@
unit U_Factory;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxDBLookupComboBox, ComObj, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges,
dxBarBuiltInMenu, U_BaseList, cxPC;
type
TfrmFactory = class(TfrmBaseList)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
btnFind: TToolButton;
ADOQueryMain: TADOQuery;
Label3: TLabel;
CoName: TEdit;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
DS_1: TDataSource;
CDS_1: TClientDataSet;
btnAdd: TToolButton;
v2Column6: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
Label1: TLabel;
CoCode: TEdit;
btnEdit: TToolButton;
v2Column12: TcxGridDBColumn;
CoAbbrName: TEdit;
Label4: TLabel;
v2Column15: TcxGridDBColumn;
CDS_2: TClientDataSet;
DS_2: TDataSource;
v2Column3: TcxGridDBColumn;
Label5: TLabel;
v2Column4: TcxGridDBColumn;
btnFollower: TToolButton;
v2Column5: TcxGridDBColumn;
Panel2: TPanel;
GPM_1: TcxGridPopupMenu;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
v3Column3: TcxGridDBColumn;
cxGridDBColumn1: TcxGridDBColumn;
Tv2Column1: TcxGridDBColumn;
cxGridLevel2: TcxGridLevel;
GPM_2: TcxGridPopupMenu;
Tv2Column2: TcxGridDBColumn;
Tv2Column3: TcxGridDBColumn;
CoBusinessType: TEdit;
btnChk: TToolButton;
btnReChk: TToolButton;
cxTabControl1: TcxTabControl;
ToolButton1: TToolButton;
ToolButton8: TToolButton;
Tv1Column1: TcxGridDBColumn;
ToolButton2: TToolButton;
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 btnFindClick(Sender: TObject);
procedure btnEditClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure TBuserClick(Sender: TObject);
procedure Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
procedure btnFollowerClick(Sender: TObject);
procedure FactTypeChange(Sender: TObject);
procedure Tv2Column2PropertiesEditValueChanged(Sender: TObject);
procedure Tv2Column3PropertiesEditValueChanged(Sender: TObject);
procedure CoCodeKeyPress(Sender: TObject; var Key: Char);
procedure btnChkClick(Sender: TObject);
procedure btnReChkClick(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure CoCodeChange(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
procedure SetStatus();
public
FAuthority: string;
end;
var
frmFactory: TfrmFactory;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp, U_FactoryInput, U_UserSel, U_AttachmentUpload,
U_FactoryImport;
{$R *.dfm}
procedure TfrmFactory.SetStatus();
begin
btnFollower.Enabled := false; //指定
btnChk.Enabled := false; //审核
btnReChk.Enabled := false; //撤销
btnAdd.Enabled := false; //新增
btnEdit.Enabled := false; //修改
TBDel.Enabled := false; //删除
if Trim(FAuthority) = '管理' then
begin
btnFollower.Enabled := true;
btnAdd.Enabled := true;
case cxTabControl1.TabIndex of
0:
begin
btnEdit.Enabled := true;
TBDel.Enabled := true;
btnChk.Enabled := true;
end;
1:
begin
btnReChk.Enabled := true;
end;
2:
begin
end;
end;
end
else
begin
btnAdd.Enabled := true;
case cxTabControl1.TabIndex of
0:
begin
btnEdit.Enabled := true;
TBDel.Enabled := true;
end;
1:
begin
end;
2:
begin
end;
end;
end;
end;
procedure TfrmFactory.InitGrid();
var
WSql, FCoCode: string;
begin
WSql := SGetFilters(Panel1, 1, 2);
if trim(WSql) <> '' then
begin
WSql := ' and ' + trim(WSql);
end;
if not CDS_1.IsEmpty then
FCoCode := CDS_1.FieldByName('CoCode').AsString;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company ');
SQL.Add(' where CoType=''供应商'' ' + (WSql));
case cxTabControl1.TabIndex of
0:
begin
sql.Add(' and status=''0'''); //已审核是1，未审核是0
end;
1:
begin
sql.Add(' and status=''1''');
end;
2:
begin
end;
end;
SQL.Add(' ORDER BY CoCode ');
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
CDS_1.Locate('CoCode', FCoCode, []);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmFactory.FormDestroy(Sender: TObject);
begin
inherited;
frmFactory := nil;
end;
procedure TfrmFactory.FactTypeChange(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmFactory.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmFactory.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmFactory.TBDelClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
while CDS_1.Locate('SSel', true, []) do
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('exec P_BS_Com_Del @COID=' + quotedstr(trim(CDS_1.fieldbyname('COID').AsString)));
sql.Add(',@DCode=' + quotedstr(trim(DCode)));
sql.Add(',@DName=' + quotedstr(trim(DName)));
ExecSQL;
end;
CDS_1.Delete;
end;
end;
procedure TfrmFactory.FormShow(Sender: TObject);
begin
inherited;
FAuthority := self.fParameters1;
ReadCxGrid(trim(self.Caption) + 'TV1', Tv1, '供应商管理');
ReadCxGrid(trim(self.Caption) + 'TV2', Tv2, '供应商管理');
SetStatus();
InitGrid();
end;
procedure TfrmFactory.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmFactory.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(trim(self.Caption) + 'TV1', Tv1, '供应商管理');
WriteCxGrid(trim(self.Caption) + 'TV2', Tv2, '供应商管理');
end;
procedure TfrmFactory.ToolButton2Click(Sender: TObject);
begin
try
frmFactoryImport := TfrmFactoryImport.Create(Application);
with frmFactoryImport do
begin
if ShowModal = 1 then
begin
self.InitGrid();
end;
end;
finally
frmFactoryImport.Free;
end;
end;
procedure TfrmFactory.btnFindClick(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmFactory.CoCodeChange(Sender: TObject);
begin
btnFind.Click;
end;
procedure TfrmFactory.CoCodeKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
InitGrid();
end;
end;
procedure TfrmFactory.cxTabControl1Change(Sender: TObject);
begin
SetStatus();
TBRafresh.Click;
end;
procedure TfrmFactory.btnEditClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
try
frmFactoryInput := TfrmFactoryInput.Create(Application);
with frmFactoryInput do
begin
FCOID := Trim(Self.CDS_1.fieldbyname('COID').AsString);
// CoCode.ReadOnly:=True;
if ShowModal = 1 then
begin
TBRafresh.Click;
end;
end;
finally
frmFactoryInput.Free;
end;
end;
procedure TfrmFactory.btnAddClick(Sender: TObject);
begin
try
frmFactoryInput := TfrmFactoryInput.Create(Application);
with frmFactoryInput do
begin
FCOID := '';
if ShowModal = 1 then
begin
InitGrid();
end;
end;
finally
frmFactoryInput.Free;
end;
end;
procedure TfrmFactory.TBuserClick(Sender: TObject);
var
FuserName: string;
begin
end;
procedure TfrmFactory.Tv2Column2PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv2.Controller.FocusedColumn.DataBinding.FilterFieldName);
if Trim(mvalue) = '' then
begin
mvalue := '0';
end;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := mvalue;
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('update BS_Company set ' + FFieldName + '=' + quotedstr(Trim(mvalue)));
sql.Add('where CoID=' + quotedstr(Trim(CDS_1.fieldbyname('CoID').AsString)));
ExecSQL;
end;
tv2.Controller.EditingController.ShowEdit();
end;
procedure TfrmFactory.Tv2Column3PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv2.Controller.FocusedColumn.DataBinding.FilterFieldName);
if Trim(mvalue) = '' then
begin
mvalue := '0';
end;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := mvalue;
Post;
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('update BS_Company set ' + FFieldName + '=' + quotedstr(Trim(mvalue)));
sql.Add('where CoID=' + quotedstr(Trim(CDS_1.fieldbyname('CoID').AsString)));
ExecSQL;
end;
tv2.Controller.EditingController.ShowEdit();
end;
procedure TfrmFactory.Tv1FocusedRecordChanged(Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean);
begin
with ADOQueryTemp do
begin
Close;
SQL.Clear;
sql.Add(' select * from BS_Company_contact where COID=' + quotedstr(Trim(CDS_1.FieldByName('COID').AsString)));
Open;
end;
SCreateCDS(ADOQueryTemp, CDS_2);
SInitCDSData(ADOQueryTemp, CDS_2);
end;
procedure TfrmFactory.btnFollowerClick(Sender: TObject);
var
MFollower, MFollowId: string;
begin
MFollower := '';
MFollowId := '';
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
try
frmUserSel := TfrmUserSel.Create(Application);
with frmUserSel do
begin
FMultiple := True;
if ShowModal = 1 then
begin
while frmUserSel.CDS_1.Locate('SSel', True, []) do
begin
if MFollowId = '' then
begin
MFollowId := Trim(CDS_1.FieldByName('UserID').AsString);
MFollower := Trim(CDS_1.FieldByName('UserName').AsString);
end
else
begin
MFollowId := MFollowId + ',' + Trim(CDS_1.FieldByName('UserID').AsString);
MFollower := MFollower + ',' + Trim(CDS_1.FieldByName('UserName').AsString);
end;
frmUserSel.CDS_1.Delete;
end;
while Self.CDS_1.Locate('SSel', True, []) do
begin
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('update BS_Company set FollowId=' + quotedstr(trim(MFollowId)));
sql.Add(' ,Follower=' + quotedstr(trim(MFollower)));
sql.Add(' where COID=''' + Trim(Self.CDS_1.fieldbyname('COID').AsString) + '''');
ExecSQL;
end;
Self.CDS_1.Delete;
end;
Self.InitGrid();
end;
end;
finally
frmUserSel.Free;
end;
end;
procedure TfrmFactory.btnChkClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
try
with CDS_1 do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('SSel').AsBoolean then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update BS_Company SET status=''1'',Chktime=getdate(),Chker=' + quotedstr(trim(DName)));
sql.Add('where CoID=' + quotedstr(trim(CDS_1.fieldbyname('CoID').AsString)));
execsql;
end;
end;
next;
end;
First;
EnableControls;
end;
application.MessageBox('审核成功！', '提示信息');
TBRafresh.Click;
except
application.MessageBox('审核失败！', '提示信息', 0);
end;
end;
procedure TfrmFactory.btnReChkClick(Sender: TObject);
begin
if CDS_1.IsEmpty then
exit;
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
try
with CDS_1 do
begin
DisableControls;
First;
while not eof do
begin
if fieldbyname('SSel').AsBoolean then
begin
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update BS_Company SET status=''0'',Chktime=null,Chker=null ');
sql.Add('where CoID=' + quotedstr(trim(CDS_1.fieldbyname('CoID').AsString)));
execsql;
end;
end;
next;
end;
First;
EnableControls;
end;
application.MessageBox('撤销审核成功！', '提示信息');
TBRafresh.Click;
except
application.MessageBox('撤销审核失败！', '提示信息', 0);
end;
end;
procedure TfrmFactory.ToolButton8Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
try
frmAttachmentUpload := TfrmAttachmentUpload.Create(Application);
with frmAttachmentUpload do
begin
if (Trim(FAuthority) = '录入') or (Trim(FAuthority) = '管理') then
FEditAuthority := True;
fkeyNO := Trim(Self.CDS_1.fieldbyname('Coid').AsString);
fType := '客户';
if ShowModal = 1 then
begin
end;
end;
finally
frmAttachmentUpload.Free;
end;
end;
end.

205
A01基础公司管理/U_FactoryImport.dfm Normal file
View File

@ -0,0 +1,205 @@
object frmFactoryImport: TfrmFactoryImport
Left = 484
Top = 189
Caption = #23458#25143#23548#20837
ClientHeight = 504
ClientWidth = 1530
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Tag = 1
Left = 0
Top = 0
Width = 1530
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ShowCaptions = True
TabOrder = 0
object TSave: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 16
OnClick = TSaveClick
end
object ToolButton4: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #25171#24320#25991#20214
ImageIndex = 4
OnClick = ToolButton4Click
end
object ToolButton2: TToolButton
Left = 166
Top = 0
AutoSize = True
Caption = #21024#34892
ImageIndex = 6
OnClick = ToolButton2Click
end
object ToolButton3: TToolButton
Left = 237
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton3Click
end
object TBClose: TToolButton
Left = 332
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxGrid1: TcxGrid
Left = 0
Top = 38
Width = 1530
Height = 466
Align = alClient
TabOrder = 1
ExplicitTop = 99
ExplicitWidth = 1366
ExplicitHeight = 372
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DS_1
DataController.Options = [dcoAssignGroupingValues, dcoAssignMasterDetailKeys, dcoSaveExpanding, dcoImmediatePost]
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
OptionsView.GroupByBox = False
Styles.IncSearch = DataLink_Company.SHuangSe
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
Styles.Inactive = DataLink_Company.SHuangSe
Styles.Selection = DataLink_Company.SHuangSe
object v2Column2: TcxGridDBColumn
Caption = #20379#24212#21830#32534#21495
DataBinding.FieldName = 'CoCode'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 86
end
object v2Column6: TcxGridDBColumn
Caption = #20379#24212#21830#20840#31216
DataBinding.FieldName = 'CoName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 127
end
object v2Column15: TcxGridDBColumn
Caption = #20379#24212#21830#31616#31216
DataBinding.FieldName = 'CoAbbrName'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 100
end
object v2Column3: TcxGridDBColumn
Caption = #20379#24212#21830#31867#22411
DataBinding.FieldName = 'CoBusinessType'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 104
end
object v2Column1: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'CONote'
PropertiesClassName = 'TcxTextEditProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 163
end
object v2Column12: TcxGridDBColumn
Caption = #25805#20316#21592
DataBinding.FieldName = 'Filler'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 60
end
object v2Column4: TcxGridDBColumn
Caption = #36319#21333#21592
DataBinding.FieldName = 'Follower'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 78
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv1
end
end
object DS_1: TDataSource
DataSet = CDS_Import
Left = 500
Top = 248
end
object CDS_Import: TClientDataSet
Aggregates = <>
Params = <>
Left = 384
Top = 252
end
object GPM_1: TcxGridPopupMenu
PopupMenus = <>
Left = 296
Top = 104
end
object ADOQueryTmp: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 88
Top = 108
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 188
Top = 108
end
object OpenDialog1: TOpenDialog
Left = 386
Top = 170
end
object CDS_LM: TClientDataSet
Aggregates = <>
Params = <>
Left = 504
Top = 176
end
end

432
A01基础公司管理/U_FactoryImport.pas Normal file
View File

@ -0,0 +1,432 @@
unit U_FactoryImport;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, cxStyles, cxCustomData, cxGraphics, cxFilter,
cxData, cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxClasses,
cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGrid, cxGridCustomPopupMenu, cxGridPopupMenu, ADODB,
DBClient, ExtCtrls, StdCtrls, BtnEdit, cxButtonEdit, cxTextEdit,
cxDropDownEdit, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, cxCalendar,
dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges, dxBarBuiltInMenu, ComObj,
cxCheckBox;
type
TfrmFactoryImport = class(TForm)
DS_1: TDataSource;
CDS_Import: TClientDataSet;
GPM_1: TcxGridPopupMenu;
ToolBar1: TToolBar;
TSave: TToolButton;
TBClose: TToolButton;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
OpenDialog1: TOpenDialog;
CDS_LM: TClientDataSet;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v2Column2: TcxGridDBColumn;
v2Column6: TcxGridDBColumn;
v2Column15: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v2Column12: TcxGridDBColumn;
v2Column4: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TSaveClick(Sender: TObject);
procedure v1P_CodeNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure v1P_SpecPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure v1QtyUnitPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure FormDestroy(Sender: TObject);
procedure Tv1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure Tv1Column3PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure Tv1Column6PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure Tv1Column4PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure ToolButton4Click(Sender: TObject);
private
procedure initGrid();
procedure SaveDate();
{ Private declarations }
public
FCOID: string;
fInvoiceFlag: string;
{ Public declarations }
end;
var
frmFactoryImport: TfrmFactoryImport;
implementation
uses
U_RTFun, U_ZDYHelp, U_CompanySel, U_dataLink;
{$R *.dfm}
procedure TfrmFactoryImport.SaveDate();
var
MaxNo: string;
begin
ADOQueryCmd.Connection.BeginTrans;
try
with CDS_Import do
begin
first;
while not eof do
begin
if fieldbyname('COID').AsString = '' then
begin
if GetLSNo(ADOQueryTmp, MaxNo, 'CO', 'BS_Company', 4, 1) = False then
raise Exception.Create('取最大号失败！');
end
else
MaxNo := CDS_Import.fieldbyname('COID').AsString;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.add('select * from BS_Company where COID=' + quotedstr(Trim(MaxNo)));
open;
end;
if ADOQueryCmd.IsEmpty then
begin
ADOQueryCmd.append;
ADOQueryCmd.FieldByName('FillId').Value := Trim(DCode);
ADOQueryCmd.FieldByName('Filler').Value := Trim(DName);
ADOQueryCmd.FieldByName('status').Value := '0';
end
else
begin
ADOQueryCmd.edit;
ADOQueryCmd.FieldByName('EditId').Value := Trim(DCode);
ADOQueryCmd.FieldByName('Editer').Value := Trim(DName);
ADOQueryCmd.FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTmp);
end;
RTSetSaveDataCDS(ADOQueryCmd, Tv1, CDS_Import, 'BS_Company', 0);
ADOQueryCmd.fieldbyname('COID').Value := MaxNo;
ADOQueryCmd.FieldByName('CoType').Value := '供应商';
ADOQueryCmd.Post;
next;
end;
end;
ADOQueryCmd.Connection.CommitTrans;
application.MessageBox('保存成功！', '提示');
Modalresult := 1;
except
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmFactoryImport.initGrid();
begin
with ADOQueryTmp do
begin
close;
sql.Clear;
sql.Add('select * from BS_Company where 1=2');
open;
end;
SCreateCDS(ADOQueryTmp, CDS_Import);
SInitCDSData(ADOQueryTmp, CDS_Import);
end;
procedure TfrmFactoryImport.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmFactoryImport.FormShow(Sender: TObject);
begin
ReadCxGrid(Self.Caption, Tv1, '财务管理');
with CDS_LM do
begin
FieldDefs.Clear;
FieldDefs.Add('LXH', ftInteger, 0);
FieldDefs.Add('lCode', ftString, 40);
FieldDefs.Add('LName', ftString, 40);
close;
CreateDataSet;
end;
initGrid();
end;
procedure TfrmFactoryImport.TSaveClick(Sender: TObject);
begin
if CDS_Import.Locate('CoCode', null, []) then
begin
application.MessageBox('编号不能为空', '提示');
exit;
end;
if CDS_Import.Locate('CoName', null, []) then
begin
application.MessageBox('名称不能为空', '提示');
exit;
end;
if CDS_Import.Locate('CoAbbrName', null, []) then
begin
application.MessageBox('简称为空', '提示');
exit;
end;
SaveDate();
end;
procedure TfrmFactoryImport.v1P_CodeNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'MPRTCodeName';
flagname := '产品名称';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('P_CodeName').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
Self.CDS_Import.FieldByName('P_Code').Value := Trim(ClientDataSet1.fieldbyname('ZDYNo').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
//self.tv1.Controller.EditingController.ShowEdit();
end;
procedure TfrmFactoryImport.v1P_SpecPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'P_Spec';
flagname := '成品规格';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('P_Spec').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmFactoryImport.v1QtyUnitPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'QtyUnit';
flagname := '数量单位';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('QtyUnit').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmFactoryImport.FormDestroy(Sender: TObject);
begin
frmFactoryImport := nil;
end;
procedure TfrmFactoryImport.Tv1Column2PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '我司';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('OurCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OurCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmFactoryImport.Tv1Column3PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := 'InvoiceType';
flagname := '发票类型';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('IVType').Value := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmFactoryImport.Tv1Column4PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '客户';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('OppCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OppCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
Self.CDS_Import.FieldByName('OppParentCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OppParentCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmFactoryImport.Tv1Column6PropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '客户';
if ShowModal = 1 then
begin
Self.CDS_Import.Edit;
Self.CDS_Import.FieldByName('OppParentCoNo').Value := Trim(CDS_1.fieldbyname('CoCode').AsString);
Self.CDS_Import.FieldByName('OppParentCoName').Value := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmFactoryImport.ToolButton2Click(Sender: TObject);
begin
if CDS_Import.IsEmpty then
exit;
CDS_Import.delete;
end;
procedure TfrmFactoryImport.ToolButton3Click(Sender: TObject);
begin
WriteCxGrid(Self.Caption, Tv1, '财务管理');
end;
procedure TfrmFactoryImport.ToolButton4Click(Sender: TObject);
var
excelApp, WorkBook: Variant;
i, j, k, LX, ExcelRowCount: integer;
maxId, FCPID, FCPName, t1, t2, t3, COID: string;
begin
try
excelApp := CreateOleObject('Excel.Application');
openDialog1.Filter := '*.CSV;*.xls';
if opendialog1.Execute then
begin
WorkBook := excelApp.WorkBooks.Open(OpenDialog1.FileName);
end
else
exit;
excelApp.Visible := false;
ExcelRowCount := WorkBook.WorkSheets[1].UsedRange.Rows.Count;
except
application.MessageBox('加载EXCEL错误！', '错误信息', MB_ICONERROR);
exit;
end;
CDS_LM.EmptyDataSet;
for j := 0 to Tv1.ColumnCount - 1 do
begin
with CDS_LM do
begin
Append;
FieldByName('LCode').Value := trim(Tv1.Columns[j].DataBinding.FieldName);
FieldByName('LName').Value := trim(Tv1.Columns[j].Caption);
Post;
end;
end;
try
for i := 1 to 50 do
begin
if trim(WorkBook.WorkSheets[1].Cells[1, i].value) = '' then
continue;
if CDS_LM.Locate('LName', trim(WorkBook.WorkSheets[1].Cells[1, i].value), []) then
begin
with CDS_LM do
begin
Edit;
FieldByName('LXH').Value := i;
Post;
end;
end;
end;
except
application.MessageBox('加载数组错误！', '错误信息', MB_ICONERROR);
exit;
end;
try
for i := 2 to ExcelRowCount do
begin
with CDS_Import do
begin
Append;
CDS_LM.First;
while not CDS_LM.Eof do
begin
if CDS_LM.FieldByName('LXH').AsInteger > 0 then
CDS_Import.fieldbyname(CDS_LM.FieldByName('LCode').AsString).Value := WorkBook.WorkSheets[1].Cells[i, CDS_LM.FieldByName('LXH').AsInteger].Value;
CDS_LM.Next;
end;
Post;
end;
end;
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
except
WorkBook.Close;
excelApp.Quit;
excelApp := Unassigned;
WorkBook := Unassigned;
exit;
end;
end;
end.

408
A01基础公司管理/U_FactoryInput.dfm Normal file
View File

@ -0,0 +1,408 @@
object frmFactoryInput: TfrmFactoryInput
Left = 261
Top = 149
Caption = #20379#24212#21830#36164#26009#24405#20837
ClientHeight = 813
ClientWidth = 1283
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
OnClose = FormClose
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar
Tag = 1
Left = 0
Top = 0
Width = 1283
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object ToolButton3: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 16
OnClick = ToolButton3Click
end
object ToolButton2: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #20445#23384#26684#24335
ImageIndex = 16
OnClick = ToolButton2Click
end
object TBClose: TToolButton
Left = 166
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object ScrollBox1: TScrollBox
Left = 0
Top = 38
Width = 1283
Height = 250
Align = alTop
BevelInner = bvNone
BevelOuter = bvNone
BorderStyle = bsNone
Color = clWhite
Ctl3D = False
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -14
Font.Name = #23435#20307
Font.Style = []
ParentColor = False
ParentCtl3D = False
ParentFont = False
TabOrder = 1
ExplicitTop = 33
object Label2: TLabel
Left = 23
Top = 33
Width = 65
Height = 12
Caption = #20379#24212#21830#32534#21495
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label6: TLabel
Left = 239
Top = 33
Width = 65
Height = 12
Caption = #20379#24212#21830#20840#31216
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label7: TLabel
Left = 34
Top = 149
Width = 54
Height = 12
Caption = #22791' '#27880
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label19: TLabel
Left = 672
Top = 33
Width = 65
Height = 12
Caption = #20379#24212#21830#31867#22411
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel
Left = 455
Top = 33
Width = 65
Height = 12
Caption = #20379#24212#21830#31616#31216
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label4: TLabel
Left = 36
Top = 75
Width = 52
Height = 24
Caption = #23454#38469#29983#20135#13#10#32463#33829#22320#22336
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 878
Top = 31
Width = 52
Height = 15
Caption = #19978#32423#21333#20301
Font.Charset = ANSI_CHARSET
Font.Color = clBlue
Font.Height = -12
Font.Name = 'Times New Roman'
Font.Style = [fsBold]
ParentFont = False
end
object CoName: TEdit
Tag = 2
Left = 310
Top = 29
Width = 123
Height = 20
TabOrder = 1
end
object CoNote: TMemo
Tag = 2
Left = 94
Top = 129
Width = 969
Height = 52
ScrollBars = ssVertical
TabOrder = 3
end
object CoAbbrName: TEdit
Tag = 2
Left = 527
Top = 29
Width = 122
Height = 20
TabOrder = 2
end
object CoCode: TEdit
Tag = 2
Left = 94
Top = 29
Width = 123
Height = 20
TabOrder = 0
end
object CoAddress: TMemo
Tag = 2
Left = 94
Top = 55
Width = 969
Height = 52
ScrollBars = ssVertical
TabOrder = 4
end
object CoBusinessType: TBtnEditC
Tag = 2
Left = 743
Top = 29
Width = 123
Height = 20
Hint = 'FactType/'#20379#24212#21830#31867#22411
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
OnBtnUpClick = COGdyBtnUpClick
OnBtnDnClick = COGdyBtnDnClick
end
object ParentCoName: TBtnEditC
Tag = 2
Left = 936
Top = 28
Width = 140
Height = 22
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
ReadOnly = True
TabOrder = 6
OnBtnUpClick = ParentCoNameBtnUpClick
end
end
object Panel2: TPanel
Left = 0
Top = 288
Width = 1283
Height = 525
Align = alClient
Caption = 'Panel1'
TabOrder = 2
object ToolBar2: TToolBar
Tag = 1
Left = 1
Top = 1
Width = 1281
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
Color = clWhite
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object ToolButton1: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #35774#20026#40664#35748
ImageIndex = 15
OnClick = ToolButton1Click
end
object ToolButton4: TToolButton
Left = 95
Top = 0
AutoSize = True
Caption = #22686#34892
ImageIndex = 2
OnClick = ToolButton4Click
end
object ToolButton5: TToolButton
Left = 166
Top = 0
AutoSize = True
Caption = #21024#34892
ImageIndex = 6
OnClick = ToolButton5Click
end
end
object cxGrid1: TcxGrid
Left = 1
Top = 39
Width = 1281
Height = 485
Align = alClient
BorderStyle = cxcbsNone
TabOrder = 1
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
Navigator.Buttons.Delete.Enabled = False
Navigator.Buttons.Delete.Visible = False
DataController.DataSource = DSLXR
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsBehavior.GoToNextCellOnEnter = True
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.DeletingConfirmation = False
OptionsView.GroupByBox = False
Styles.Footer = DataLink_Company.Default
Styles.Header = DataLink_Company.Default
object v3Column3: TcxGridDBColumn
Caption = #40664#35748
DataBinding.FieldName = 'IsDefault'
PropertiesClassName = 'TcxCheckBoxProperties'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 76
end
object Tv1Column1: TcxGridDBColumn
Caption = #32852#31995#20154
DataBinding.FieldName = 'Contacts'
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 108
end
object Tv1Column2: TcxGridDBColumn
Caption = #32852#31995#30005#35805
DataBinding.FieldName = 'Telephone'
HeaderAlignmentHorz = taCenter
Width = 66
end
object cxGridDBColumn1: TcxGridDBColumn
Caption = #25163#26426#21495
DataBinding.FieldName = 'PhoneNumber'
PropertiesClassName = 'TcxTextEditProperties'
Properties.CharCase = ecUpperCase
HeaderAlignmentHorz = taCenter
Width = 86
end
object Tv1Column3: TcxGridDBColumn
Caption = #22791#27880
DataBinding.FieldName = 'note'
HeaderAlignmentHorz = taCenter
Width = 66
end
end
object cxGridLevel1: TcxGridLevel
GridView = Tv1
end
end
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 659
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 582
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 501
Top = 1
end
object CDS_LXR: TClientDataSet
Aggregates = <>
Params = <>
Left = 593
Top = 351
end
object DSLXR: TDataSource
DataSet = CDS_LXR
Left = 672
Top = 359
end
object GPM_2: TcxGridPopupMenu
PopupMenus = <>
Left = 774
Top = 350
end
end

496
A01基础公司管理/U_FactoryInput.pas Normal file
View File

@ -0,0 +1,496 @@
unit U_FactoryInput;
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, cxDropDownEdit, BtnEdit, cxLookAndFeels, cxLookAndFeelPainters,
cxNavigator, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges,
dxBarBuiltInMenu, U_BaseList;
type
TfrmFactoryInput = class(TForm)
ToolBar1: TToolBar;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ADOQueryMain: TADOQuery;
ToolButton3: TToolButton;
CDS_LXR: TClientDataSet;
DSLXR: TDataSource;
ScrollBox1: TScrollBox;
Label2: TLabel;
Label6: TLabel;
Label7: TLabel;
Label19: TLabel;
CoName: TEdit;
CoNote: TMemo;
Label1: TLabel;
CoAbbrName: TEdit;
CoCode: TEdit;
GPM_2: TcxGridPopupMenu;
Label4: TLabel;
CoAddress: TMemo;
CoBusinessType: TBtnEditC;
Panel2: TPanel;
ToolBar2: TToolBar;
ToolButton1: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v3Column3: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
cxGridDBColumn1: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
ToolButton2: TToolButton;
Label5: TLabel;
ParentCoName: TBtnEditC;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure COGdyBtnDnClick(Sender: TObject);
procedure COGdyBtnUpClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ParentCoNameBtnUpClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
function SaveData(): Boolean;
public
fkhType: string;
{ Public declarations }
FCOID: string;
end;
var
frmFactoryInput: TfrmFactoryInput;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp, U_CompanySel;
{$R *.dfm}
procedure TfrmFactoryInput.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company where CoType=''供应商'' and COID=''' + Trim(FCOID) + '''');
Open;
end;
SCSHData(ADOQueryMain, ScrollBox1, 2);
ParentCoName.TxtCode := ADOQueryMain.FieldByName('ParentCoCode').AsString;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from BS_Company_contact where COID=' + quotedstr(Trim(FCOID)));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_LXR);
SInitCDSData(ADOQueryMain, CDS_LXR);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmFactoryInput.ParentCoNameBtnUpClick(Sender: TObject);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
FCoType := '供应商';
if ShowModal = 1 then
begin
ParentCoName.Text := Trim(CDS_1.fieldbyname('CoAbbrName').AsString);
ParentCoName.TxtCode := Trim(CDS_1.fieldbyname('CoCode').AsString);
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TfrmFactoryInput.FormDestroy(Sender: TObject);
begin
frmFactoryInput := nil;
end;
procedure TfrmFactoryInput.COGdyBtnDnClick(Sender: TObject);
begin
TBtnEditC(Sender).Text := '';
TBtnEditC(Sender).TxtCode := '';
end;
procedure TfrmFactoryInput.COGdyBtnUpClick(Sender: TObject);
var
fsj: string;
FWZ: Integer;
begin
fsj := Trim(TEdit(Sender).Hint);
FWZ := Pos('/', fsj);
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := Copy(fsj, 1, FWZ - 1);
flagname := Copy(fsj, FWZ + 1, Length(fsj) - FWZ);
if ShowModal = 1 then
begin
TEdit(Sender).Text := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
procedure TfrmFactoryInput.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmFactoryInput.TBCloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmFactoryInput.FormShow(Sender: TObject);
begin
ReadCxGrid(trim(self.Caption) + 'TV1', Tv1, '供应商管理');
InitGrid();
if trim(FCOID) = '' then
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add(' exec P_BS_Com_Get_No @Str=''G'' ');
Open;
end;
CoCode.Text := trim(ADOQueryTemp.FieldByName('NewCoCode').asstring);
end;
end;
procedure TfrmFactoryInput.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
function TfrmFactoryInput.SaveData(): Boolean;
var
MaxId, MaxSubId, FCoCode, FCCID: string;
begin
try
ADOQueryCmd.Connection.BeginTrans;
if Trim(FCOID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxId, 'CO', 'BS_Company', 4, 1) = False then
begin
Result := False;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败！', '提示', 0);
Exit;
end;
if trim(CoCode.Text) = '' then
begin
with ADOQueryTemp do
begin
Close;
sql.Clear;
sql.Add(' exec P_BS_Com_Get_No @Str=''G'' ');
Open;
end;
CoCode.Text := trim(ADOQueryTemp.FieldByName('NewCoCode').asstring);
end;
end
else
begin
MaxId := Trim(FCOID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from BS_Company where COID=''' + Trim(FCOID) + '''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FCOID) = '' then
begin
Append;
FieldByName('FillId').Value := Trim(DCode);
FieldByName('Filler').Value := Trim(DName);
FieldByName('status').Value := '0';
end
else
begin
Edit;
FieldByName('EditId').Value := Trim(DCode);
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('COID').Value := Trim(MaxId);
RTSetsavedata(ADOQueryCmd, 'BS_Company', ScrollBox1, 2);
FieldByName('CoType').Value := '供应商';
FieldByName('ParentCoCode').Value := ParentCoName.TxtCode;
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoCode=' + quotedstr(trim(CoCode.Text)));
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('供应商编号重复!', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoName=' + quotedstr(trim(CoName.Text)));
sql.Add(' and CoType=''供应商'' ');
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('供应商名称重复!', '提示', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company where CoAbbrName=' + quotedstr(trim(CoAbbrName.Text)));
sql.Add(' and CoType=''供应商'' ');
Open;
end;
if ADOQueryCmd.RecordCount > 1 then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('供应商简称重复!', '提示', 0);
Exit;
end;
////////////// 联系人 ///////////////////
if not CDS_LXR.IsEmpty then
begin
with CDS_LXR do
begin
CDS_LXR.First;
while not Eof do
begin
FCCID := Trim(CDS_LXR.fieldbyname('CCID').AsString);
if Trim(FCCID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxSubId, 'CCS', 'BS_Company_contact', 4, 1) = False then
begin
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('取系人最大ID失败!', '提示', 0);
Exit;
end;
end
else
begin
MaxSubId := trim(FCCID);
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from BS_Company_contact where CCID=' + quotedstr(Trim(MaxSubId)));
Open;
end;
with ADOQueryCmd do
begin
if Trim(FCCID) = '' then
begin
Append;
end
else
begin
Edit;
end;
FieldByName('CCID').Value := Trim(MaxSubId);
FieldByName('COID').Value := Trim(MaxId);
RTSetSaveDataCDS(ADOQueryCmd, Tv1, CDS_LXR, 'BS_Company_contact', 0);
Post;
end;
with CDS_LXR do
begin
Edit;
FieldByName('CCID').Value := Trim(MaxSubId);
Post;
end;
CDS_LXR.Next;
end;
end;
end;
////////////// 联系人 ///////////////////
//////////////// 更新名称 ////////////////////////
// with ADOQueryCmd do
// begin
// Close;
// sql.Clear;
// sql.Add('exec P_Com_Up_Code @COID=' + quotedstr(Trim(MaxId)));
// ExecSQL;
// end;
//////////////// 更新名称 ////////////////////////
ADOQueryCmd.Connection.CommitTrans;
FCCID := Trim(MaxSubId);
Result := True;
except
Result := false;
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存异常!', '提示', 0);
end;
end;
procedure TfrmFactoryInput.ToolButton3Click(Sender: TObject);
begin
if Trim(CoAbbrName.Text) = '' then
begin
Application.MessageBox('简称不能为空!', '提示', 0);
Exit;
end;
if Trim(CoName.Text) = '' then
begin
Application.MessageBox('名称不能为空!', '提示', 0);
Exit;
end;
if SaveData() then
begin
Application.MessageBox('保存成功!', '提示', 0);
ModalResult := 1;
end;
end;
procedure TfrmFactoryInput.ToolButton4Click(Sender: TObject);
var
maxno: string;
begin
if GetLSNo(ADOQueryCmd, maxno, 'CC', 'BS_Company_contact', 4, 1) = False then
begin
Application.MessageBox('取系人最大ID失败!', '提示', 0);
Exit;
end;
if CDS_LXR.IsEmpty then
begin
with CDS_LXR do
begin
Append;
fieldbyname('CCID').Value := trim(maxno);
fieldbyname('IsDefault').Value := true;
Post;
end;
end
else
begin
with CDS_LXR do
begin
Append;
fieldbyname('CCID').Value := trim(maxno);
fieldbyname('IsDefault').Value := false;
Post;
end;
end;
end;
procedure TfrmFactoryInput.ToolButton5Click(Sender: TObject);
begin
if CDS_LXR.IsEmpty then
Exit;
if Trim(CDS_LXR.fieldbyname('CCID').AsString) <> '' then
begin
if Application.MessageBox('确定要删除数据吗？', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete from BS_Company_contact where CCID=''' + Trim(CDS_LXR.fieldbyname('CCID').AsString) + '''');
ExecSQL;
end;
end;
CDS_LXR.Delete;
if CDS_LXR.IsEmpty = false then
begin
if CDS_LXR.Locate('IsDefault', true, []) = false then
begin
CDS_LXR.first;
CDS_LXR.edit;
CDS_LXR.FieldByName('IsDefault').value := true;
end;
end;
end;
procedure TfrmFactoryInput.ToolButton1Click(Sender: TObject);
var
DwFlag: string;
begin
DwFlag := trim(CDS_LXR.FieldByName('CCID').AsString);
if CDS_LXR.Locate('IsDefault', true, []) then
begin
CDS_LXR.edit;
CDS_LXR.FieldByName('IsDefault').value := false;
end;
if CDS_LXR.Locate('CCID', DwFlag, []) then
begin
CDS_LXR.edit;
CDS_LXR.FieldByName('IsDefault').value := true;
end;
end;
procedure TfrmFactoryInput.ToolButton2Click(Sender: TObject);
begin
WriteCxGrid(trim(self.Caption) + 'TV1', Tv1, '供应商管理');
end;
end.

188
A01基础公司管理/U_FileUp.dfm Normal file
View File

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

357
A01基础公司管理/U_FileUp.pas Normal file
View File

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

273
A01基础公司管理/U_GetDllForm.pas Normal file
View File

@ -0,0 +1,273 @@
unit U_GetDllForm;
interface
uses
Windows, Messages, forms, OleCtnrs, DateUtils, SysUtils, ADODB, dxCore,
ActiveX, IniFiles;
function GetDllForm(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; export; stdcall;
function ConnData(): Boolean;
implementation
uses
U_DataLink, U_Customer, U_Factory, U_Company, U_EmployeeList, U_SYDept,
U_BankList, U_ModulePromptList;
/////////////////////////////////////////////////////////////////
// 功能说明:取Dll中得窗体 //
// 参数说明：App>>调用应用程序； //
// FormH>>调用窗口句柄 ； //
// FormID>>窗口号; //
// Language>>语言种类; //
// WinStyle>>窗口类型； //
/////////////////////////////////////////////////////////////////
var
frmCustomerYW, frmCustomerGQX: TfrmCustomer;
function GetDllForm(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd;
var
i: Integer;
bFound: Boolean;
mnewHandle: hwnd;
mstyle: TFormStyle; // 0:子窗口; 1：普通窗口
mstate: TWindowState;
mborderstyle: TFormBorderStyle;
begin
mnewHandle := 0;
DName := PChar(GName);
DCode := PChar(GCode);
DdataBase := DataBase;
DTitCaption := Title;
DParameters1 := Parameters1;
DParameters2 := Parameters2;
DParameters3 := Parameters3;
DParameters4 := Parameters4;
DParameters5 := Parameters5;
DParameters6 := Parameters6;
DParameters7 := Parameters7;
DParameters8 := Parameters8;
DParameters9 := Parameters9;
DParameters10 := Parameters10;
SetLength(fDllFileName, 255);
GetModuleFileName(HInstance, PChar(fDllFileName), Length(fDllFileName));
fDllFileName := ExtractFileName(PChar(fDllFileName));
MainApplication := App;
DCurHandle := FormH;
IsDelphiLanguage := Language;
Application := TApplication(App);
DCurHandle := 0;
//赋值链接字符串
SetLength(server, 255);
SetLength(dtbase, 255);
SetLength(user, 255);
SetLength(pswd, 255);
if trim(DataBaseStr) = '' then
begin
server := '101.132.143.144,7781';
dtbase := 'HENGYANData';
user := 'rtsa';
pswd := 'rightsoft@5740';
DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
// Parameters1 := '录入';
Parameters1 := '管理';
// DCode := 'L01';
// DCode := 'L02';
end
else
begin
DConString := DataBaseStr;
end;
if not ConnData() then
begin
result := 0;
exit;
end;
// 定义窗口类型 、状态
if WinStyle = 0 then
begin
mstyle := fsMDIChild;
mstate := wsMaximized;
mborderstyle := bsSizeable;
end
else
begin
mstyle := fsNormal;
mstate := wsNormal;
mborderstyle := bsSizeable;
end;
bFound := False;
if FormID <> 10000 then
begin
for i := 0 to Application.MainForm.MDIChildCount - 1 do
begin
if Application.MainForm.MDIChildren[i].Caption = Title then
begin
mnewHandle := Application.MainForm.MDIChildren[i].Handle;
Application.MainForm.MDIChildren[i].BringToFront;
bFound := True;
Result := mnewHandle;
exit;
end;
end;
end;
/////////////////////
//调用子模块窗口
case FormID of
100: //提示窗口
begin
with TfrmModulePromptList.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
111: //客户管理
begin
with TfrmCustomer.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
121: //供应商管理
begin
with TfrmFactory.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
131: //公司管理
begin
with TfrmCompany.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
141: //公司账户管理
begin
with TfrmBankList.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
211: //组织机构
begin
with TfrmSYDept.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
212: //员工档案管理
begin
with TfrmEmployeeList.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
10000:
begin
for i := 0 to application.MainForm.MDIChildCount - 1 do
begin
if application.MainForm.MDIChildren[i].Caption = Title then
begin
application.MainForm.MDIChildren[i].Close;
end;
end;
end;
end;
Result := mnewHandle;
end;
//===========================================================
//建立数据库连接池
//===========================================================
function ConnData(): Boolean;
var
IniFile: TIniFile;
begin
try
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'SYSTEMSET.INI');
PicSvr := IniFile.ReadString('SERVER', '服务器地址', '127.0.0.1');
UserDataFlag := IniFile.ReadString('SERVER', '服务器地址类型', '-1');
finally
IniFile.Free;
end;
if not Assigned(DataLink_Company) then
DataLink_Company := TDataLink_Company.Create(Application);
try
with DataLink_Company.ADOLink do
begin
//if not Connected then
begin
Connected := false;
ConnectionString := DConString;
LoginPrompt := false;
Connected := true;
end;
end;
Result := true;
except
Result := false;
application.MessageBox('数据库连接失败！', '错误', mb_Ok + MB_ICONERROR);
end;
end;
initialization
CoInitialize(nil);
dxUnitsLoader.Initialize;
finalization
DataLink_Company.Free;
application := NewDllApp;
dxUnitsLoader.Finalize;
end.

313
A01基础公司管理/U_LabelAdd.dfm Normal file
View File

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

455
A01基础公司管理/U_LabelAdd.pas Normal file
View File

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

438
A01基础公司管理/U_LabelList.dfm Normal file
View File

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

591
A01基础公司管理/U_LabelList.pas Normal file
View File

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

181
A01基础公司管理/U_ModuleNote.dfm Normal file
View File

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

220
A01基础公司管理/U_ModuleNote.pas Normal file
View File

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

185
A01基础公司管理/U_ModulePromptList.dfm Normal file
View File

@ -0,0 +1,185 @@
inherited frmModulePromptList: TfrmModulePromptList
Left = 262
Top = 164
Caption = #25105#30340#31649#23478
ClientHeight = 508
ClientWidth = 1321
ExplicitWidth = 1337
ExplicitHeight = 547
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 1321
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 75
Caption = 'ToolBar1'
Color = clWhite
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ParentFont = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBClose: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object Panel1: TPanel [1]
Left = 0
Top = 38
Width = 1321
Height = 41
Align = alTop
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 1
object Panel2: TPanel
Left = 936
Top = 2
Width = 383
Height = 37
Align = alRight
BevelOuter = bvNone
Caption = #25552#31034#65306#21452#20987#25171#24320#22788#29702#20449#24687#30028#38754
Color = clSkyBlue
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
end
end
object cxGrid1: TcxGrid [2]
Left = 0
Top = 79
Width = 1321
Height = 429
Align = alClient
TabOrder = 2
ExplicitTop = 83
object Tv1: TcxGridDBTableView
Navigator.Buttons.CustomButtons = <>
OnCellDblClick = Tv1CellDblClick
DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end
item
Kind = skSum
end>
DataController.Summary.SummaryGroups = <>
OptionsCustomize.ColumnFiltering = False
OptionsData.Deleting = False
OptionsData.Editing = False
OptionsSelection.CellSelect = False
OptionsView.GroupByBox = False
OptionsView.Indicator = True
Styles.Header = DataLink_Company.FontBlue
object v1Column5: TcxGridDBColumn
Caption = #24453#22788#29702#20107#39033
DataBinding.FieldName = 'ModuleName'
HeaderAlignmentHorz = taCenter
Width = 235
end
object v1Column1: TcxGridDBColumn
Caption = #22788#29702#20154
DataBinding.FieldName = 'DName'
HeaderAlignmentHorz = taCenter
Width = 107
end
end
object cxGrid1Level1: TcxGridLevel
GridView = Tv1
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 241
Top = 192
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 369
Top = 193
end
object cxGridPopupMenu1: TcxGridPopupMenu
PopupMenus = <>
Left = 1128
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 896
Top = 168
end
object ADOQueryMain: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 976
Top = 232
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 1040
Top = 248
end
object DataSource1: TDataSource
DataSet = Order_Main
Left = 1168
Top = 8
end
object Order_Main: TClientDataSet
Aggregates = <>
Params = <>
Left = 815
Top = 7
end
object cxGridPopupMenu2: TcxGridPopupMenu
PopupMenus = <>
Left = 506
Top = 195
end
end

182
A01基础公司管理/U_ModulePromptList.pas Normal file
View File

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

238
A01基础公司管理/U_SYDept.dfm Normal file
View File

@ -0,0 +1,238 @@
inherited frmSYDept: TfrmSYDept
Left = 312
Top = 149
Caption = #32452#32455#32467#26500
ClientHeight = 470
ClientWidth = 988
ExplicitWidth = 1004
ExplicitHeight = 509
PixelsPerInch = 96
TextHeight = 12
object ToolBar1: TToolBar [0]
Tag = 1
Left = 0
Top = 0
Width = 988
Height = 38
AutoSize = True
ButtonHeight = 38
ButtonWidth = 91
Caption = 'ToolBar1'
Color = clSkyBlue
DisabledImages = DataLink_Company.ImageList_new32
Images = DataLink_Company.ImageList_new32
List = True
ParentColor = False
ShowCaptions = True
TabOrder = 0
object TBRafresh: TToolButton
Left = 0
Top = 0
AutoSize = True
Caption = #21047#26032
ImageIndex = 1
OnClick = TBRafreshClick
end
object TBAdd: TToolButton
Left = 71
Top = 0
AutoSize = True
Caption = #26032#22686#23376#31867
ImageIndex = 2
OnClick = TBAddClick
end
object ToolButton1: TToolButton
Left = 166
Top = 0
AutoSize = True
Caption = #20445#23384
ImageIndex = 16
OnClick = ToolButton1Click
end
object TBDel: TToolButton
Left = 237
Top = 0
AutoSize = True
Caption = #21024#38500
ImageIndex = 5
OnClick = TBDelClick
end
object ToolButton2: TToolButton
Left = 308
Top = 0
AutoSize = True
Caption = #32452#32455#20998#37197
ImageIndex = 20
Visible = False
end
object TBClose: TToolButton
Left = 403
Top = 0
AutoSize = True
Caption = #20851#38381
ImageIndex = 7
OnClick = TBCloseClick
end
end
object cxDBTreeList1: TcxDBTreeList [1]
Left = 0
Top = 38
Width = 249
Height = 432
Align = alLeft
Bands = <
item
end>
DataController.DataSource = DataSource1
DataController.ParentField = 'DPParent'
DataController.KeyField = 'DPID'
Navigator.Buttons.CustomButtons = <>
OptionsBehavior.CopyCaptionsToClipboard = False
OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True
OptionsView.Headers = False
RootValue = -1
Styles.Inactive = DataLink_Company.Red
Styles.Selection = DataLink_Company.Red
Styles.IncSearch = DataLink_Company.Red
TabOrder = 1
OnClick = cxDBTreeList1Click
ExplicitTop = 18
ExplicitHeight = 452
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'DPName'
Width = 210
Position.ColIndex = 0
Position.RowIndex = 0
Position.BandIndex = 0
Summary.FooterSummaryItems = <>
Summary.GroupFooterSummaryItems = <>
end
end
object Panel1: TPanel [2]
Left = 249
Top = 38
Width = 739
Height = 432
Align = alClient
BevelInner = bvRaised
BevelOuter = bvLowered
Color = clSkyBlue
TabOrder = 2
ExplicitTop = 18
ExplicitWidth = 379
ExplicitHeight = 452
object Label1: TLabel
Left = 41
Top = 40
Width = 48
Height = 12
Caption = #19978#32423#32452#32455
end
object Label2: TLabel
Left = 41
Top = 81
Width = 48
Height = 12
Caption = #32452#32455#21517#31216
end
object Label3: TLabel
Left = 41
Top = 121
Width = 48
Height = 12
Caption = #32452#32455#32534#30721
end
object Label4: TLabel
Left = 24
Top = 16
Width = 60
Height = 14
Caption = #32452#32455#32467#26500
Font.Charset = GB2312_CHARSET
Font.Color = clRed
Font.Height = -14
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 41
Top = 159
Width = 48
Height = 12
Caption = #39034' '#24207' '#21495
end
object DPTopName: TEdit
Left = 104
Top = 37
Width = 169
Height = 20
ReadOnly = True
TabOrder = 0
end
object DPName: TEdit
Left = 104
Top = 77
Width = 169
Height = 20
TabOrder = 1
OnKeyPress = DPNameKeyPress
end
object DPNo: TEdit
Left = 104
Top = 117
Width = 169
Height = 20
TabOrder = 2
end
object DPOrder: TEdit
Left = 104
Top = 155
Width = 169
Height = 20
TabOrder = 3
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 313
Top = 248
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_Company.ADOLink
Left = 401
Top = 241
end
object DataSource1: TDataSource
DataSet = CDS_Tree
Left = 147
Top = 219
end
object ADOQueryTree: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 117
Top = 145
end
object ADOQueryTemp: TADOQuery
Connection = DataLink_Company.ADOLink
LockType = ltReadOnly
Parameters = <>
Left = 528
Top = 215
end
object ADOQueryCmd: TADOQuery
Connection = DataLink_Company.ADOLink
Parameters = <>
Left = 520
Top = 258
end
object CDS_Tree: TClientDataSet
Aggregates = <>
Params = <>
Left = 96
Top = 256
end
end

276
A01基础公司管理/U_SYDept.pas Normal file
View File

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

296
A01基础公司管理/U_SYDeptUserView.dfm Normal file
View File

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

336
A01基础公司管理/U_SYDeptUserView.pas Normal file
View File

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

304
A01基础公司管理/U_SYDeptView.dfm Normal file
View File

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

344
A01基础公司管理/U_SYDeptView.pas Normal file
View File

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

557
A01基础公司管理/U_UserModuleNameList.dfm Normal file
View File

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

221
A01基础公司管理/U_UserModuleNameList.pas Normal file
View File

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

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