employeesfm.pas
来自「群星医药系统源码」· PAS 代码 · 共 273 行
PAS
273 行
unit EmployeesFm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, DBClient, MConnect, Grids, DBGridEh, DbUtilsEh, EhLibCDS, ExtCtrls, RzButton,
RzBorder, DBCtrls, ActnList,xBaseFrm,ImainFrm, xEhLibCtl, ModuleAction,
ImgList,ckDBClient,Dbfuncs, Menus, TFlatSpeedButtonUnit, TFlatPanelUnit,
RzStatus,uDataTypes;
type
TFmEmployees = class(TxBaseForm)
Panel1: TPanel;
Panel2: TPanel;
RzBorder1: TRzBorder;
BtnNew: TRzBitBtn;
BitBtn2: TRzBitBtn;
BtnPrint: TRzBitBtn;
BtnEdit: TRzBitBtn;
BtnDel: TRzBitBtn;
BtnFind: TRzBitBtn;
RzBitBtn1: TRzBitBtn;
ActionList1: TActionList;
ActRefresh: TModlAction;
ActNew: TModlAction;
ActModify: TModlAction;
ActDelete: TModlAction;
DsEmployees: TDataSource;
DComConn1: TDCOMConnection;
dbgEmployees: TxDBGridEh;
ActFind: TModlAction;
ActPrint: TModlAction;
ActExit: TModlAction;
CdsEmployees: TckClientDataSet;
CdsEmployeesEmpNo: TStringField;
CdsEmployeesNAME: TStringField;
CdsEmployeesDepartID: TIntegerField;
CdsEmployeesDUTY: TStringField;
CdsEmployeesState: TStringField;
CdsEmployeesHireDate: TDateTimeField;
CdsEmployeesFireDate: TDateTimeField;
CdsEmployeesDEGREE: TStringField;
CdsEmployeesSPECIALTY: TStringField;
CdsEmployeesOLDNAME: TStringField;
CdsEmployeesSex: TStringField;
CdsEmployeesCARDID: TStringField;
CdsEmployeesBIRTHDAY: TDateTimeField;
CdsEmployeesNativePlace: TStringField;
CdsEmployeesAddress: TStringField;
CdsEmployeesTEL: TStringField;
CdsEmployeesMobile: TStringField;
CdsEmployeesLinkMan: TStringField;
CdsEmployeesLinkTel: TStringField;
CdsEmployeesRemark: TStringField;
CdsEmployeesDepartName: TStringField;
ptBkPanel: TFlatPanel;
ptCaption: TRzMarqueeStatus;
FlatPanel2: TPanel;
BtnWhatIs: TFlatSpeedButton;
BtnHelp: TFlatSpeedButton;
FlatPanel3: TPanel;
BtnPopMenu: TFlatSpeedButton;
TopPopMenu: TPopupMenu;
SetFields1: TMenuItem;
refresh1: TMenuItem;
ImageList1: TImageList;
ActFieldsLayOut: TModlAction;
ActDataExport: TModlAction;
ActDesignReport: TModlAction;
RzBitBtn2: TRzBitBtn;
ActMore: TModlAction;
procedure ActRefreshExecute(Sender: TObject);
procedure ActModifyExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ActExitExecute(Sender: TObject);
procedure ActPrintExecute(Sender: TObject);
procedure ActFindExecute(Sender: TObject);
procedure ActDeleteExecute(Sender: TObject);
procedure ActNewExecute(Sender: TObject);
procedure CdsEmployeesDEPTGetText(Sender: TField; var Text: String;
DisplayText: Boolean);
procedure CdsEmployeesNewRecord(DataSet: TDataSet);
procedure dbgEmployeesDblClick(Sender: TObject);
procedure ActFieldsLayOutExecute(Sender: TObject);
procedure ActDataExportExecute(Sender: TObject);
procedure BtnPopMenuClick(Sender: TObject);
procedure CdsEmployeesReconcileError(DataSet: TCustomClientDataSet;
E: EReconcileError; UpdateKind: TUpdateKind;
var Action: TReconcileAction);
private
IFmMain :IMainForm;
iClientID :integer;
LocSetting: PLocSetting;
CdsFieldProPerty :TckClientDataSet;
SvrCommon,SvrEmployees:TDispatchConnection;
public
{ Public declarations }
end;
const
sFieldProPerty='select * from SysFieldProperty '+
'where TableName=''Employees''';
var
FmEmployees: TFmEmployees;
implementation
uses EmpEdFrm, ShowProGress,RepSelectFrm,FieldsLayoutFrm,DataExportFrm, ceGlobal;
{$R *.dfm}
procedure TFmEmployees.ActRefreshExecute(Sender: TObject);
begin
CdsEmployees.Active:=False;
CdsEmployees.Active:=True;
end;
procedure TFmEmployees.ActModifyExecute(Sender: TObject);
begin
if CdsEmployees.IsEmpty then exit;
With TFmEmpEd.Create(self) Do begin
dsEmployees.DataSet := CdsEmployees;
CdsEmployees.Edit;
edEmpId.ReadOnly:=True;
if (ShowModal<>mrOk) then
Begin
CdsEmployees.Cancel;
CdsEmployees.CancelUpdates;
End;
Free;
End;
end;
procedure TFmEmployees.FormCreate(Sender: TObject);
begin
CdsFieldProPerty := TckClientDataSet.Create(self);
IFmMain:=Application.MainForm as IMainForm;
iClientID:=IFmMain.IFmMainEx.ClientID;
SetGressHint('正在连接到员工资料管理服务器...');
SvrEmployees:=IFmMain.GetConnection(Handle,'','EmployeesSvr.Employees');
SetGressHint('正在连接到公用信息服务器...');
SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
CdsEmployees.RemoteServer:=SvrEmployees;
CdsFieldProPerty.RemoteServer:=SvrCommon;
SetGressHint('正在读取用户操作权限...');
IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
LocSetting := IFmMain.IFmMainEx.GetLocSetting;
end;
procedure TFmEmployees.FormShow(Sender: TObject);
var sTableNames :String;
begin
SetGressHint('初始化本地环境...');
ptBkPanel.Color := TitlePanelColor;
ptCaption.FillColor := TitlePanelColor;
SetGridEhColor([dbgEmployees]);
CdsFieldProPerty.ProviderName:='DspTemp';
SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TEmployees.Xml');
sTableNames:='Employees';
SetFieldProperty(CdsFieldProPerty,CdsEmployees,sTableNames);
SetGressHint('读取历史单据...');
CdsEmployees.Open;
dbgEmployees.SetAutoSort('');
FreeGressForm;
end;
procedure TFmEmployees.ActExitExecute(Sender: TObject);
begin
Close;
end;
procedure TFmEmployees.ActPrintExecute(Sender: TObject);
begin
SelRepPrint(self.Name, [CdsEmployees], '员工资料',ActDesignReport.Enabled);
end;
procedure TFmEmployees.ActFindExecute(Sender: TObject);
begin
//
end;
procedure TFmEmployees.ActDeleteExecute(Sender: TObject);
begin
If CdsEmployees.IsEmpty Then Exit;
if Application.MessageBox('确实要删除此员工资料吗?','信息提示',4+32)=6 Then
Begin
CdsEmployees.Delete;
try
CdsEmployees.ApplyUpdates(0);
except
Messagebox(handle,'删除数据失败','提示',MB_ICONWARNING+MB_ok);
end;
End;
end;
procedure TFmEmployees.ActNewExecute(Sender: TObject);
begin
If CdsEmployees.State in dsEditModes Then Exit;
With TFmEmpEd.Create(self) Do begin
dsEmployees.DataSet := CdsEmployees;
edEmpId.ReadOnly:=False;
CdsEmployees.Append;
If ShowModal <> mrOk Then Begin
CdsEmployees.Cancel;
CdsEmployees.CancelUpdates;
End;
Free;
End;
end;
procedure TFmEmployees.CdsEmployeesDEPTGetText(Sender: TField;
var Text: String; DisplayText: Boolean);
begin
try
Text:=DComConn1.AppServer.Getname(CdsEmployeesDepartID.AsString);
except
Text:='';
end;
end;
procedure TFmEmployees.CdsEmployeesNewRecord(DataSet: TDataSet);
begin
CdsEmployeesHireDate.Value := Date;
CdsEmployeesFireDate.AsVariant := null;
CdsEmployeesBIRTHDAY.AsVariant := null;
end;
procedure TFmEmployees.dbgEmployeesDblClick(Sender: TObject);
begin
if ActModify.Execute then;
end;
procedure TFmEmployees.ActFieldsLayOutExecute(Sender: TObject);
begin
SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
[dbgEmployees],'员工基本资料');
end;
procedure TFmEmployees.ActDataExportExecute(Sender: TObject);
begin
ExportData([CdsEmployees],'员工基本资料', '');
end;
procedure TFmEmployees.BtnPopMenuClick(Sender: TObject);
Var tp:TPoint;
begin
tp.X:=BtnPopMenu.Left;
tp.Y:=BtnPopMenu.Top+BtnPopMenu.Height+1;
tp:=ClientToScreen(tp);
TopPopmenu.Popup(tp.x,tp.Y);
end;
procedure TFmEmployees.CdsEmployeesReconcileError(
DataSet: TCustomClientDataSet; E: EReconcileError;
UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
Messagebox(Handle,Pchar(E.Message),Nil,16);
Action := RaAbort;
end;
initialization
RegisterClass(TFmEmployees);
finalization
UnRegisterClass(TFmEmployees);
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?