oldgatheringfrm.pas

群星医药系统源码

unit OldGatheringFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, xBaseFrm, MConnect, ckDBClient,
  ShowProgress, Grids, DBGridEh, xEhLibCtl, ExtCtrls, RzPanel,
  RzButton, ActnList, ModuleAction, ImgList, RzStatus, StdCtrls, Mask,
  RzEdit, RzBtnEdt, ComCtrls, RzTreeVw, RzSplit,FieldsLayoutFrm,
  TFlatSpeedButtonUnit,IMainFrm, uDataTypes, DbFuncs, ceGlobal,
  SelectCustFrm, SelectGoodsFrm, SelectEmpFrm, RepSelectFrm,
  DataExportFrm, Menus, RzRadChk;

type
  TFmOldGathering = class(TxBaseForm)
    cdsOldGathering: TckClientDataSet;
    cdsOldGatheringFDate: TDateTimeField;
    cdsOldGatheringCustNo: TStringField;
    cdsOldGatheringCustName: TStringField;
    cdsOldGatheringDepartID: TIntegerField;
    cdsOldGatheringDepartNo: TStringField;
    cdsOldGatheringDepartName: TStringField;
    cdsOldGatheringPBillNo: TStringField;
    cdsOldGatheringPItemNo: TIntegerField;
    cdsOldGatheringPayDate: TDateTimeField;
    cdsOldGatheringAmount: TBCDField;
    cdsOldGatheringPaidUp: TBCDField;
    cdsOldGatheringUnPaid: TBCDField;
    cdsOldGatheringEmpNo: TStringField;
    cdsOldGatheringGoodsID: TStringField;
    cdsOldGatheringCreater: TStringField;
    cdsOldGatheringMender: TStringField;
    dsOldGathering: TDataSource;
    ImageList1: TImageList;
    ActionList1: TActionList;
    ActRefresh: TModlAction;
    ActNew: TModlAction;
    ActModify: TModlAction;
    ActDelete: TModlAction;
    ActFilter: TModlAction;
    ActAudit: TModlAction;
    ActRevert: TModlAction;
    ActPrint: TModlAction;
    ActDesignReport: TModlAction;
    plLeft: TRzSizePanel;
    tvDeparts: TRzTreeView;
    Panel3: TRzPanel;
    plClient: TRzPanel;
    RzPanel2: TRzPanel;
    dbgOldGathering: TxDBGridEh;
    RzPanel3: TRzPanel;
    btnAdd: TRzBitBtn;
    btnEdit: TRzBitBtn;
    btnDel: TRzBitBtn;
    RzBitBtn1: TRzBitBtn;
    edtCustNo: TRzButtonEdit;
    BtnPopMenu: TFlatSpeedButton;
    BtnUnFiltered: TRzBitBtn;
    btnCancel: TRzBitBtn;
    RzPanel4: TRzPanel;
    btnAudit: TRzBitBtn;
    btnRevert: TRzBitBtn;
    btnExit: TRzBitBtn;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    ActFieldLayout: TModlAction;
    ActDataExport: TModlAction;
    btnPost: TRzBitBtn;
    lbCustName: TLabel;
    RzBitBtn3: TRzBitBtn;
    lbTransfer: TLabel;
    chkCustID: TRzCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tvDepartsChange(Sender: TObject; Node: TTreeNode);
    procedure FormDestroy(Sender: TObject);
    procedure dbgOldGatheringEditButtonClick(Sender: TObject);
    procedure ActNewExecute(Sender: TObject);
    procedure ActModifyExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActRefreshExecute(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure edtCustNoButtonClick(Sender: TObject);
    procedure BtnUnFilteredClick(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure cdsOldGatheringAfterInsert(DataSet: TDataSet);
    procedure cdsOldGatheringAfterPost(DataSet: TDataSet);
    procedure tvDepartsCollapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure cdsOldGatheringBeforePost(DataSet: TDataSet);
    procedure ActFilterExecute(Sender: TObject);
    procedure tvDepartsChanging(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
    procedure ActPrintExecute(Sender: TObject);
    procedure btnPostClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure cdsOldGatheringPaidUpChange(Sender: TField);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure cdsOldGatheringBeforeInsert(DataSet: TDataSet);
  private
    { Private declarations }
    iFmMain:IMainForm;
    iClientID :integer;
    LogonInfo: PLogonInfo;
    LocSetting: PLocSetting;
    CdsFieldProPerty :TckClientDataSet;
    cdsDeparts: TckClientDataSet;
    cdsTemp: TckClientDataSet;
    sDepartNoFmt: String;
    SvrDepartInfo: TDispatchConnection;
    SvrGathering: TDispatchConnection;
    procedure GetDepartNoAndName(sText: string; var sNo,sName: string);
    procedure ShowCompanys;
    function GetLevel(sFormat,sCode:String):Integer;
  public
    { Public declarations }
  end;

const
  sFieldProPerty='select * from SysFieldProperty ' +
                 'where TableName in (''OldGathering'',''Departs'')';
var
  FmOldGathering: TFmOldGathering;

implementation

{$R *.dfm}

procedure TFmOldGathering.FormCreate(Sender: TObject);
begin
  Inherited;
  CdsFieldProPerty := TckClientDataSet.Create(self);
  cdsTemp := TckClientDataSet.Create(self);
  cdsDeparts := TckClientDataSet.Create(self); 
  SetGressHint('正在登录到历史数据服务器...');
  iFmMain:=Application.mainForm as iMainForm;
  LogonInfo := IFmMain.IFmMainEx.LogonInfo;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SvrGathering := IFmMain.GetConnection(Handle,'','ckHistoryData.HistoryData');
  SvrDepartInfo:=IFmMain.GetConnection(Handle, '', 'dptinfosvr.svrdepart');
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  iClientID:=IFmMain.IFmMainEx.ClientID;
  cdsOldGathering.RemoteServer := SvrGathering;
  with cdsTemp do begin
    RemoteServer := SvrDepartInfo;
    ProviderName :='dspPublic';
  end;
  with cdsDeparts do begin
    RemoteServer := SvrDepartInfo;
    ProviderName :='dspDepart';
  end;
  with CdsFieldProPerty do begin
    RemoteServer:=SvrDepartInfo;
    ProviderName:='DspPublic';
  end;
end;

procedure TFmOldGathering.FormShow(Sender: TObject);
var sTableNames: String;
begin
  inherited;
  SetGressHint('初始化本地环境...');
  plLeft.Color := FormBackColor;
  plClient.Color := FormBackColor;
  dbgOldGathering.FixedColor := GridFixColor;
  SetGridEhColor([dbgOldGathering]);
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgOldGathering]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TOldGathering.Xml');
  SetFieldProperty(CdsFieldProPerty,cdsOldGathering, 'OldGathering,Departs');
  SetGressHint('读取历史记录...');
  cdsOldGathering.Open;
  ShowCompanys;
  FreeGressForm;
end;

procedure TFmOldGathering.FormDestroy(Sender: TObject);
var i: integer;
begin
  Inherited;
  {with tvDeparts do
  for i:=0 to Items.Count-1 do
    if Items.Item[i].Data <> nil then
      Dispose(Items.Item[i].Data);}
end;

function TFmOldGathering.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 TFmOldGathering.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;
  tvDeparts.Images :=ImageList1;
  aNode := tvDeparts.Items.AddChild(nil, '[所有公司]');
  aNode.Data := nil;
  vNodes[Level] := aNode;
  with cdsDeparts do begin
    If Not Active then Open;
    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);
          if SvrGathering.AppServer.IsAudited(iClientID, iDepartID,1) then
          with aNode do begin
            aNode.ImageIndex :=4;
            aNode.SelectedIndex :=4;
            aNode.StateIndex :=-1;
          end
          else
          with aNode do begin
            aNode.ImageIndex :=23;
            aNode.SelectedIndex :=23;
            aNode.StateIndex :=-1;
          end;
          {aNode.Data :=NewStr(sDepartNo);}
          vNodes[Level] := aNode;
        end;
        //以上是增加子项
        Next;
      end;
    finally
      vNodes[0].Selected := true;
      EnableControls;
    end;
  end;
  tvDeparts.FullExpand;
end;

procedure TFmOldGathering.tvDepartsChange(Sender: TObject; Node: TTreeNode);
var sDepartNo, str: String;
    i, k: integer;
begin
  lbTransfer.Caption :='';
  if Node.Data =nil then begin
    cdsOldGathering.Close;
    exit;
  end;
  i := Integer(Node.Data);
  str := 'DepartID=' + inttostr(i);
  if SvrGathering.AppServer.IsAudited(iClientID, i,1) then
  begin
    lbTransfer.Caption :='（已过帐）';
    lbTransfer.Font.Color :=clRed;