departfrm.~pas

医药连锁经营管理系统源码

unit DepartFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, StdCtrls, ComCtrls, RzTreeVw,
  ExtCtrls, RzPanel, RzSplit, RzButton, ImgList, DB, DBClient, ckDBClient,
  ActnList, ModuleAction, MConnect, Menus, TFlatSpeedButtonUnit,
  xBaseFrm, IMainFrm, uDataTypes, Mask, RzEdit;

type
  TFmDeparts = class(TxBaseForm)
    Panel1: TRzSizePanel;
    tvDeparts: TRzTreeView;
    Panel2: TPanel;
    dbgDeparts: TxDBGridEh;
    Label2: TPanel;
    cdsDeparts: TckClientDataSet;
    cdsDepartsDepartID: TAutoIncField;
    cdsDepartsDepartNo: TStringField;
    cdsDepartsDepartName: TStringField;
    cdsDepartsTel: TStringField;
    cdsDepartsFax: TStringField;
    cdsDepartsPrincipal: TStringField;
    cdsDepartsDataUsable: TBooleanField;
    cdsDepartsCreater: TStringField;
    cdsDepartsCreatTime: TDateTimeField;
    cdsDepartsMender: TStringField;
    cdsDepartsUpdateTime: TDateTimeField;
    cdsDepartsGrup: TIntegerField;
    cdsTemp: TckClientDataSet;
    Panel3: TPanel;
    RzBitBtn8: TRzBitBtn;
    RzBitBtn9: TRzBitBtn;
    RzBitBtn10: TRzBitBtn;
    RzPanel1: TPanel;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn4: TRzBitBtn;
    RzBitBtn5: TRzBitBtn;
    BtnFresh: TRzBitBtn;
    DCOMConnection1: TDCOMConnection;
    BtnPopMenu: TFlatSpeedButton;
    ActionList1: TActionList;
    ActAdd: TModlAction;
    ActNewDepart: TModlAction;
    ActEdit: TModlAction;
    ActDel: TModlAction;
    ActFieldLayout: TModlAction;
    ActDataExport: TModlAction;
    ActPrint: TModlAction;
    ActDesignReport: TModlAction;
    ImageList1: TImageList;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    dsDeparts: TDataSource;
    cdsDepartsIsCompany: TBooleanField;
    ActQuery: TModlAction;
    ModlAction2: TModlAction;
    ActEditDepart: TModlAction;
    ActDelDepart: TModlAction;
    Label1: TLabel;
    edFastSearch: TRzEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure refresh1Click(Sender: TObject);
    procedure tvDepartsChange(Sender: TObject; Node: TTreeNode);
    procedure BtnFreshClick(Sender: TObject);
    procedure ActAddExecute(Sender: TObject);
    procedure ActEditExecute(Sender: TObject);
    procedure ActDelExecute(Sender: TObject);
    procedure ActNewDepartExecute(Sender: TObject);
    procedure ActEditDepartExecute(Sender: TObject);
    procedure ActDelDepartExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActPrintExecute(Sender: TObject);
    procedure cdsDepartsNewRecord(DataSet: TDataSet);
    procedure tvDepartsCollapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure edFastSearchChange(Sender: TObject);
    procedure edFastSearchKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    iFmMain:IMainForm;
    iClientID :integer;
    LogonInfo: PLogonInfo;
    LocSetting: PLocSetting;
    CdsFieldProPerty :TckClientDataSet;
    function GetLevel(sFormat,sCode:String):Integer;
    procedure ShowCompanys;
    procedure AddDepart(AddCompany: Boolean);
    procedure EditDepart(IsCompany: Boolean);
  protected
    sDepartNoFmt: String;
    SvrDepartInfo: TDispatchConnection;
  public
    { Public declarations }
  end;

const
  sFieldProPerty='select * from SysFieldProperty where TableName=''Departs''';

var
  FmDeparts: TFmDeparts;

implementation

{$R *.dfm}

uses DepartEdFrm, ceGlobal,ShowProGress,RepSelectFrm,DataExportFrm,FieldsLayoutFrm,Dbfuncs;

procedure TFmDeparts.FormCreate(Sender: TObject);
begin
  Inherited;
  CdsFieldProPerty := TckClientDataSet.Create(self);
  SetGressHint('正在登录到部门资料管理服务器...');
  iFmMain:=Application.mainForm as iMainForm;
  LogonInfo := IFmMain.IFmMainEx.LogonInfo;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SvrDepartInfo:=IFmMain.GetConnection(Handle, '', 'dptinfosvr.svrdepart');
  SetGressHint('正在连接到公用信息服务器...');
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  iClientID:=IFmMain.IFmMainEx.ClientID;
  cdsDeparts.RemoteServer := SvrDepartInfo;
  cdsTemp.RemoteServer := SvrDepartInfo;
  CdsFieldProPerty.RemoteServer:=SvrDepartInfo;
  CdsFieldProPerty.ProviderName:='DspPublic';
end;

procedure TFmDeparts.FormShow(Sender: TObject);
var sTableNames: String;
begin
  inherited;
  SetGressHint('初始化本地环境...');
//  ptBkPanel.Color := TitlePanelColor;
//  ptCaption.FillColor := TitlePanelColor;
  SetGridEhColor([dbgDeparts]);
  dbgDeparts.SetAutoSort('');
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgDeparts]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TDepart.Xml');
  sTableNames:='Departs';
  SetFieldProperty(CdsFieldProPerty,cdsDeparts,sTableNames);
  SetGressHint('读取历史记录...');
  cdsDeparts.Open;
  ShowCompanys;
  FreeGressForm;
end;

function TFmDeparts.GetLevel(sFormat,sCode:String):Integer;
var i,Level,iLen:Integer;
begin
  Level:=-1;//如果代码不符合标准，则返回-1
  iLen:=0;
  if (sFormat<>'')and(sCode<>'')then
    for i:=1 to Length(sFormat) do begin
      iLen := iLen+StrToInt(sFormat[i]);
      if Length(sCode)=iLen then begin
        Level:=i;
        Break;
      end;
    end;
  Result:=Level;
end;

procedure TFmDeparts.ShowCompanys;
var sDepartNo, sDepartName, Str: String;
    h, Level, iDepartID:Integer;
    vNodes:Array of TTreeNode; //保存各级节点
    aNode: TTreeNode;
begin
  if sDepartNoFmt='' then with cdsTemp do begin
    Close;
    CommandText := 'SELECT DepartNoFormat FROM SysSetting ';
    Open;
    sDepartNoFmt := Fields[0].AsString;
    if sDepartNoFmt='' then begin
      Application.MessageBox('请先设置部门编码格式！', '消息', MB_ICONINFORMATION);
      Exit;
    end;
  end;
  Level := 0;
  h := Length(sDepartNoFmt);
  SetLength(vNodes, h+1);
  tvDeparts.Items.Clear;
  aNode := tvDeparts.Items.AddChild(nil, '[所有公司]');
  aNode.Data := nil;
  vNodes[Level] := aNode;
  with cdsDeparts do begin
    DisableControls;
    Filter := 'IsCompany';
    Filtered := true;
    try
      First;
      while not eof do begin
        iDepartID := Fields[0].AsInteger;
        sDepartNo := Trim(Fields[1].AsString);
        sDepartName := Fields[2].AsString;
        Level:=GetLevel(sDepartNoFmt, sDepartNo);//返回代码的级数
        //以下是增加子项
        //以下用上一级节点为父节点添加子节点
        if Level>0 then begin//确保代码符合标准
          str := sDepartNo+'['+sDepartName+']';
          aNode := tvDeparts.Items.AddChild(vNodes[Level-1], str);
          aNode.Data := Pointer(iDepartID);
          vNodes[Level] := aNode;
        end;
        //以上是增加子项
        Next;
      end;
    finally
      vNodes[0].Selected := true;
      EnableControls;
    end;
  end;
  tvDeparts.FullExpand;
end;

procedure TFmDeparts.BtnPopMenuClick(Sender: TObject);
var tp:TPoint;
begin
	tp.x:=BtnPopMenu.left;
	tp.y:=BtnPopMenu.Top+BtnPopMenu.Height+1;
	tp:=BtnPopMenu.Parent.ClientToScreen(tp);
	TopPopmenu.Popup(tp.x,tp.Y);
end;

procedure TFmDeparts.refresh1Click(Sender: TObject);
begin
	ExportData([cdsDeparts], '期初库存', '');
end;

procedure TFmDeparts.tvDepartsChange(Sender: TObject; Node: TTreeNode);
var sDepartNo, str: String;
    i, k: integer;
begin
  str := Node.Text;
  i := AnsiPos('[', str);
  if i=1 then begin
    str := '1<>1';
  end else begin
    sDepartNo := Copy(str, 1, i-1);
    i := Node.Level+1;
    if i>Length(sDepartNoFmt) then
      str := '1<>1'
    else begin
      k := StrToInt(sDepartNoFmt[i]);
      for i:=0 to k-1 do
        sDepartNo := sDepartNo+'_';
      str := 'IsCompany=0 and DepartNo like '''+sDepartNo+''' ';
    end;
  end;
  cdsDeparts.Filter := str;
  cdsDeparts.Filtered := true;
end;

procedure TFmDeparts.BtnFreshClick(Sender: TObject);
begin
  cdsDeparts.Refresh;
end;

procedure TFmDeparts.AddDepart(AddCompany: Boolean);
var pNode: TTreeNode;
    i, j, iNo: integer;
    sPrefix, str, str2, sFilter: String;
begin
  pNode := tvDeparts.Selected;
  if pNode=nil then Exit;
  i := pNode.Level+1;
  if i>Length(sDepartNoFmt) then begin
    Application.MessageBox('已到达最低一级公司，不能再增加', '消息', MB_ICONINFORMATION);
    Exit;
  end;
  if (i=1) and not AddCompany then
    Exit;
  j := StrToInt(sDepartNoFmt[i]);
  str := pNode.Text;
  i := AnsiPos('[', str);
  if i>1 then
    sPrefix := Copy(str, 1, i-1);
  str := sPrefix;
  for i:=0 to j-1 do
    str := str+'_';
  sFilter := cdsDeparts.Filter;
  cdsDeparts.DisableControls;
  try
    cdsDeparts.Filter := 'DepartNo like '''+str+'''';
    cdsDeparts.Last;
    str2 := cdsDepartsDepartNo.AsString;
    i := pNode.Count;
    if i>0 then begin
      str := pNode.Item[i-1].Text;
      i := AnsiPos('[', str);
      str := Copy(str, 1, i-1);
    end else
      str := '';
    if str>str2 then
      str2 := str;
    if str2<>'' then begin
      i := Length(sPrefix);
      iNo := StrToInt(Copy(str2, i+1, Length(str2)-i))+1;
    end else
      iNo := 1;
    cdsDeparts.Append;
    cdsDepartsIsCompany.Value := AddCompany;
    with TFmDepartEd.Create(self) do begin
      lbHint.Visible := AddCompany;
      dsDeparts.DataSet := cdsDeparts;
      edNo.MaxLength := j;
      edNo.IntValue := iNo;
      edPrefix.Text := sPrefix;
      if ShowModal=mrOk then begin
        if AddCompany then begin
          tvDeparts.Items.AddChild(pNode, sNewDepartNo+'['+sNewDepartName+']');
          pNode.Expanded := true;
        end;
      end;
      Free;
    end;
  finally
    cdsDeparts.Filter := sFilter;
    cdsDeparts.EnableControls;
  end;
end;

procedure TFmDeparts.EditDepart(IsCompany: Boolean);
var Node: TTreeNode;
    i, j: Integer;
    sPrefix, str, sNo: string;
begin
  Node := tvDeparts.Selected;
  if IsCompany then
    Node := Node.Parent;
  str := Node.Text;
  i := AnsiPos('[', str);
  sPrefix := Copy(str, 1, i-1);
  str := cdsDepartsDepartNo.AsString;
  j := StrToInt(sDepartNoFmt[Node.Level+1]);
  i := Length(sPrefix);
  sNo := Copy(str, i+1, Length(str)-i);
  cdsDeparts.Edit;
  with TFmDepartEd.Create(self) do begin
    dsDeparts.DataSet := cdsDeparts;
    edNo.MaxLength := j;
    edNo.Text := sNo;
    edPrefix.Text := sPrefix;
    if ShowModal=mrOk then begin
      if ISCompany then begin
        tvDeparts.Selected.Text := sNewDepartNo+'['+sNewDepartName+']';
      end;
    end;
    Free;
  end;
end;

procedure TFmDeparts.ActAddExecute(Sender: TObject);
begin
  AddDepart(true);
end;

procedure TFmDeparts.ActEditExecute(Sender: TObject);
var Node: TTreeNode;
    i: Integer;
    str: String;
begin
  Node := tvDeparts.Selected;
  if (Node=nil)or(Node.Level=0) then Exit;
  str := Node.Text;
  i := AnsiPos('[', str);
  str := Copy(str, 1, i-1);
  with cdsDeparts do begin
    DisableControls;
    Filtered := false;
    try
      if not Locate('DepartNo', str, []) then
        raise Exception.Create('找不到数据记录，请刷新后再试！');
      EditDepart(true);
    finally
      Filtered := true;
      EnableControls;
    end;
  end;
end;

procedure TFmDeparts.ActDelExecute(Sender: TObject);
var Node: TTreeNode;
    i: Integer;
    str: String;
begin
  Node := tvDeparts.Selected;
  if (Node=nil)or(Node.Level=0) then Exit;
  if not cdsDeparts.IsEmpty then begin
    Application.MessageBox('不能删除一个有部门资料的公司记录！', '消息', MB_ICONINFORMATION);
    Exit;
  end;
  if Application.MessageBox('确定删除此公司资料吗？', '警告', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  str := Node.Text;
  i := AnsiPos('[', str);
  str := Copy(str, 1, i-1);
  with cdsDeparts do begin
    DisableControls;
    Filtered := false;
    try
      if not Locate('DepartNo', str, []) then
        raise Exception.Create('找不到数据记录，请刷新后再试！');
      cdsDeparts.Delete;
      if cdsDeparts.ApplyUpdates(0)>0 then begin
        Application.MessageBox('数据提交失败，资料没有删除！', '消息', MB_ICONINFORMATION);
        cdsDeparts.cancelUpdates;
      end else
        Node.delete;
    finally
      Filtered := true;
      EnableControls;
    end;
  end;
end;

procedure TFmDeparts.ActNewDepartExecute(Sender: TObject);
begin
  AddDepart(false);
end;
                         
procedure TFmDeparts.ActEditDepartExecute(Sender: TObject);
begin
  EditDepart(false);
end;

procedure TFmDeparts.ActDelDepartExecute(Sender: TObject);
begin
  if cdsDeparts.IsEmpty then
    Exit;
  if Application.MessageBox('确定删除此部门资料吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  cdsDeparts.Delete;
  if cdsDeparts.ApplyUpdates(0)>0 then begin
    Application.MessageBox('数据提交失败！', '消息', MB_ICONINFORMATION);
    cdsDeparts.CancelUpdates;
  end;
end;

procedure TFmDeparts.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgDeparts], '公司(部门)资料');
end;

procedure TFmDeparts.ActDataExportExecute(Sender: TObject);
begin
	ExportData([cdsDeparts], '公司(部门)资料', '');
end;

procedure TFmDeparts.ActPrintExecute(Sender: TObject);
begin
  SelRepPrint(Name, [cdsDeparts], '公司(部门)资料', ActDesignReport.Enabled);
end;

procedure TFmDeparts.cdsDepartsNewRecord(DataSet: TDataSet);
begin
  cdsDepartsDataUsable.Value := true;
  cdsDepartsCreater.Value := LogonInfo^.UserID;
  cdsDepartsGrup.Value := LogonInfo^.UserGrupID;
end;

procedure TFmDeparts.tvDepartsCollapsing(Sender: TObject; Node: TTreeNode;
  var AllowCollapse: Boolean);
begin
  AllowCollapse := Node.Level>0;
end;

procedure TFmDeparts.edFastSearchChange(Sender: TObject);
const
  MatchFields : array[0..3]of string=('DepartNo','DepartName','Tel','Fax');
var
  i: integer;
begin
  with cdsDeparts do begin
    i :=0;
    if (not Active) or IsEmpty or (edFastSearch.Text ='') then exit;
    while (i<4)and(not Locate(MatchFields[i],edFastSearch.Text,[loPartialKey,loCaseInsensitive])) do
      inc(i);
  end;
end;

procedure TFmDeparts.edFastSearchKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=VK_UP)or(Key=VK_DOWN) then begin
    PostMessage(dbgDeparts.Handle,WM_KEYDOWN,key,0);
    key :=0;
  end;
end;

initialization
  RegisterClass(TFmDeparts);
Finalization
  UnRegisterClass(TFmDeparts);

end.