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 + -
显示快捷键?