initstockfrm.pas

来自「群星医药系统源码」· PAS 代码 · 共 651 行 · 第 1/2 页

unit InitStockFrm;

interface

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

type
  TFmInitStock = class(TxBaseForm)
    RzPanel1: TRzPanel;
    RzSizePanel1: TRzSizePanel;
    RzPanel2: TRzPanel;
    tvDepots: TRzTreeView;
    Label1: TPanel;
    DCOMConnection1: TDCOMConnection;
    cdsInitStock: TckClientDataSet;
    dsInitStock: TDataSource;
    cdsTemp: TckClientDataSet;
    Panel1: TPanel;
    dbgInitStock: TxDBGridEh;
    plTitle: TPanel;
    plBottom: TPanel;
    edQty: TRzEdit;
    edAmount: TRzEdit;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn4: TRzBitBtn;
    Label2: TLabel;
    Label3: TLabel;
    ActionList1: TActionList;
    ActAdd: TModlAction;
    ActCopy: TModlAction;
    ActDel: TModlAction;
    ActEdit: TModlAction;
    ActChangeUnit: TModlAction;
    ActDataExport: TModlAction;
    BtnDataFilter: TRzBitBtn;
    cdsInitStockDepotID: TIntegerField;
    cdsInitStockDepotNo: TStringField;
    cdsInitStockBerthNo: TStringField;
    cdsInitStockGoodsID: TStringField;
    cdsInitStockName: TStringField;
    cdsInitStockSpecs: TStringField;
    cdsInitStockPdcAddr: TStringField;
    cdsInitStockMaker: TStringField;
    cdsInitStockUnit: TStringField;
    cdsInitStockQty: TBCDField;
    cdsInitStockPrice: TFloatField;
    cdsInitStockAmount: TBCDField;
    cdsInitStockBatchNo: TStringField;
    cdsInitStockValidDate: TDateTimeField;
    cdsInitStockItemNo: TIntegerField;
    BtnPopMenu: TFlatSpeedButton;
    lbDepotInfo: TLabel;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    ActFieldLayout: TModlAction;
    ActDoInitialize: TModlAction;
    ActUndoInitialize: TModlAction;
    ActPrint: TModlAction;
    ActDesignReport: TModlAction;
    ImageList1: TImageList;
    RzBitBtn6: TRzBitBtn;
    RzBitBtn7: TRzBitBtn;
    edBerthNo: TRzEdit;
    edGoodsID: TRzButtonEdit;
    BtnUnFiltered: TRzBitBtn;
    RzMenuButton1: TRzMenuButton;
    Label4: TLabel;
    Label5: TLabel;
    cdsDepots: TckClientDataSet;
    Panel2: TPanel;
    BtnDoInitialize: TRzBitBtn;
    BtnUndoInitialize: TRzBitBtn;
    cdsInitStockProvNo: TStringField;
    cdsInitStockProvName: TStringField;
    ckAddByProvNo: TRzCheckBox;
    edProvNo: TRzButtonEdit;
    PopupMenu1: TPopupMenu;
    ActPrint1: TMenuItem;
    ActBuildInitStock: TModlAction;
    ActClearZero: TModlAction;
    ModlAction3: TModlAction;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tvDepotsDblClick(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure ActAddExecute(Sender: TObject);
    procedure ActCopyExecute(Sender: TObject);
    procedure ActDelExecute(Sender: TObject);
    procedure ActChangeUnitExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure cdsInitStockBeforeClose(DataSet: TDataSet);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure cdsInitStockQtyChange(Sender: TField);
    procedure dbgInitStockEditButtonClick(Sender: TObject);
    procedure cdsInitStockNewRecord(DataSet: TDataSet);
    procedure RzBitBtn6Click(Sender: TObject);
    procedure RzBitBtn7Click(Sender: TObject);
    procedure edGoodsIDKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cdsInitStockBeforeOpen(DataSet: TDataSet);
    procedure BtnDataFilterClick(Sender: TObject);
    procedure BtnUnFilteredClick(Sender: TObject);
    procedure ActDoInitializeExecute(Sender: TObject);
    procedure ActUndoInitializeExecute(Sender: TObject);
    procedure edProvNoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edProvNoButtonClick(Sender: TObject);
    procedure ActPrintExecute(Sender: TObject);
    procedure tvDepotsCollapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure ActBuildInitStockExecute(Sender: TObject);
    procedure ActClearZeroExecute(Sender: TObject);
    procedure edGoodsIDButtonClick(Sender: TObject);
  private
    IFmMain: IMainForm;
    LocSetting: PLocSetting;
    iClientID: Integer;
    CurrDepotID: Integer;
    CurrDepotNo: String;
    SvrStock:TDispatchConnection;
    CdsFieldProPerty:TCkClientDataSet;

    function GetLevel(sFormat,sCode:String):Integer;
    Procedure FillDepotList;
    function  StockInited(iDepotID: Integer): Boolean;
  public
    { Public declarations }
  end;

Const
  sFieldProPerty='Select * From SysFieldProPerty '+
      ' Where TableName in(''InitStock'', ''Depots'', ''Goodses'')';

var
  FmInitStock: TFmInitStock;

implementation

uses SelectBerthFrm, FieldsLayoutFrm, DataExportFrm, SelectGoodsFrm, SelectProvFrm,
  ShowProgress, RepSelectFrm;

{$R *.dfm}

{ TFmInitStock }

procedure TFmInitStock.FormCreate(Sender: TObject);
begin
  IFmMain := Application.MainForm as IMainForm;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  iClientID := IFmMain.IFmMainEx.ClientID;
  SetGressHint('正在连接应用服务器...');
  SvrStock := IFmMain.GetConnection(Handle,'','CkStockSvr.Stock');
  cdsInitStock.RemoteServer := SvrStock;
  cdsDepots.RemoteServer := SvrStock;
  cdsTemp.RemoteServer := SvrStock;
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  CdsFieldProPerty.ProviderName := 'DspPublic';
  CdsFieldProPerty.RemoteServer := SvrStock;
  SetGressHint('正在建立仓库树图...');
  FillDepotList;
end;

procedure TFmInitStock.FormShow(Sender: TObject);
begin
  SetGressHint('初始化本地环境...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  dbgInitStock.ReadOnly := not ActEdit.Enabled;
  SetGridEhColor([dbgInitStock]);
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgInitStock]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty, ClassName+'.Xml');
  SetFieldProperty(CdsFieldProPerty, cdsInitStock, 'InitStock,Depots,Goodses');
  FreeGressForm;
end;

procedure TFmInitStock.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  try
    cdsInitStockBeforeClose(cdsInitStock);
  except
    CanClose := Application.MessageBox('数据已修改，但提交到服务器失败！请检查您所修改的内容是否正确。'#13'按[是]返回修改，按[否]继续退出，将丢失本次修改的记录！', '消息', MB_YESNO+MB_ICONWARNING)=IDNO;
  end;
end;

//下面函数的功能是返回一代码的级数，参数sFormat传递代码结构；
//参数sCode传递某一类别代码
function TFmInitStock.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 TFmInitStock.FillDepotList;
var sDepotNoFmt, sDepotNo, sDepotName, Str: String;
    h, Level, iDepotID:Integer;
    b1, b2: Boolean;
    vNodes:Array of TTreeNode; //保存各级节点
    aNode: TTreeNode;
begin
  if sDepotNoFmt='' then with cdsTemp do begin
    Close;
    CommandText := 'SELECT DepotNoFormat FROM SysSetting ';
    Open;
    sDepotNoFmt := Fields[0].AsString;
    if sDepotNoFmt='' then begin
      Application.MessageBox('请先设置仓库编码格式！', '消息', MB_ICONINFORMATION);
      Exit;
    end;
  end;
  with cdsDepots do begin
    Close;
    CommandText := 'select DepotID, DepotNo, DepotName, RankDepot, initialized, DefBerthNo from Depots order by DepotNo';
    Open;
    h := Length(sDepotNoFmt);
    SetLength(vNodes, h+1);
    Level := 0;
    tvDepots.Items.Clear;
    aNode := tvDepots.Items.AddChild(nil, '[所有仓库]');
    aNode.Data := nil;
    vNodes[Level] := aNode;
    First;
    while not eof do begin
      iDepotID := Fields[0].AsInteger;
      sDepotNo := Trim(Fields[1].AsString);
      sDepotName := Fields[2].AsString;
      b1 := Fields[3].AsBoolean;
      b2 := Fields[4].AsBoolean;
      Level:=GetLevel(sDepotNoFmt, sDepotNo);//返回代码的级数
      //以下是增加子项
      //以下用上一级节点为父节点添加子节点
      if Level>0 then begin//确保代码符合标准
        str := sDepotNo+'['+sDepotName+']';
        if not b1 then begin
          if b2 then
            str := str+'(已初始化库存)'
          else
            str := str+'(未初始化库存)';
        end;
        aNode := tvDepots.Items.AddChild(vNodes[Level-1], str);
        aNode.Data := Pointer(iDepotID);
        vNodes[Level] := aNode;
      end;
      //以上是增加子项
      Next;
    end;
  end;
  tvDepots.FullExpand;
//  vNodes[0].Expanded := true;
end;

procedure TFmInitStock.tvDepotsDblClick(Sender: TObject);
var aNode: TTreeNode;
    sDepotNo, sDepotName: String;
    iDepotID: Integer;
    b1: Boolean;
begin
  aNode := tvDepots.Selected;
  if aNode=nil then Exit;
  iDepotID := integer(aNode.Data);
  if iDepotID=0 then begin
    b1 := true;
    sDepotNo := '';
    sDepotName := '[所有仓库]';
  end else begin
    if not cdsDepots.Locate('DepotID', iDepotID, []) then
      raise Exception.Create('找不到仓库记录');
    b1 := cdsDepots.FieldByName('RankDepot').AsBoolean;
    sDepotNo := cdsDepots.FieldByName('DepotNo').AsString;
    sDepotName := cdsDepots.FieldByName('DepotName').AsString;
  end;
  if b1 then
    sDepotNo := sDepotNo+'%';
  with cdsInitStock do begin
    if Params.Items[0].Value=sDepotNo then Exit;
    close;
    Params.Items[0].Value := sDepotNo;
    Open;
    lbDepotInfo.Caption := {'期初库存：'+}sDepotNo+'['+sDepotName+']';
  end;
  CurrDepotID := iDepotID;
  CurrDepotNo := sDepotNo;
  plBottom.Enabled := not b1;
  with cdsTemp do begin
    Close;
    if iDepotID=0 then//所有仓库
      CommandText := 'select Sum(Qty), Sum(Amount) from InitStock'
    else
      CommandText := 'select Sum(Qty), Sum(Amount) from InitStock I '
                    +'where exists(select 1 from Depots D where I.DepotID=d.DepotID and D.DepotNo like '''+sDepotNo+''')';
    Open;
    edQty.Text := Fields[0].AsString;
    edAmount.Text := Fields[1].AsString;
  end;
end;

procedure TFmInitStock.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;